VBA初心者です。シート1の文字列をシート2のリストにコピーしたい。

質問

VBA初心者です。
ExcelのVBAでシート1の文字列をシート2のリストに追加したいのですが
すでにリストに登録されているものは(重複するもの)追加しないようにしたいのですがうまくいきません。

シート1のA列に「商品名」B列に「色番号」が入力されています。
A　　　B
1ペン　１２３
2ペン　２３３
3ペン　１２３
4ペン　２２２
※A列とB列はセットです。
このようになっていたとして、それぞれに変数A・Bを用意して
シート2の商品リストに入れていくのですが
1行目と3行目のように重複するものは(すでにリストに入っているもの)
1つ目だけをリストに加え、2回目以降のものはリストに加えたくありません。
条件をIF文で書いているのですが、重複するものの判定がうまくいかず
困っています。

シート1には毎回違う納品書がくるのでフィルタ等で重複を
探すことはできません。

回答No.5

mitarashi

やり方は、星の数ほどあるでしょうが（大げさ）、最近find等に頼らない、基本的なコードに立ち返ってみる機会がありましたので、試しにやってみました。白状すると、少々手こずりました。Sheet2には、1行目に商品名、色番号の見出しを入れておいて下さい。（空の状態からの実行する場合）
動作が冗長な分、高速化のため、一旦配列に入れてから処理しています。
Sub test()
Dim table1 As Variant, table2 As Variant
Dim i As Long, j As Long
Dim lastRow1 As Long, lastRow2 As Long
Dim hitFlag As Boolean

lastRow1 = Sheets("Sheet1").Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
table1 = Sheets("Sheet1").Range("A1:B" & lastRow1)
'Sheet2には見出しを設けておく
For i = 1 To lastRow1
lastRow2 = Sheets("Sheet2").Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
table2 = Sheets("Sheet2").Range("A1:B" & lastRow2)
hitFlag = False
For j = 1 To lastRow2
If (table1(i, 1) = table2(j, 1)) And (table1(i, 2) = table2(j, 2)) Then hitFlag = True
Next j
If hitFlag = False Then
Sheets("Sheet2").Cells(lastRow2 + 1, 1).Value = table1(i, 1)
Sheets("Sheet2").Cells(lastRow2 + 1, 2).Value = table1(i, 2)
End If
Next i
End Sub

お礼

明確な回答ありがとうございました。
配列に入れるところは、まだ私では思いつかなかったので
非常に参考になりました。

ありがとうございました。

回答No.4

noname#99913

わざわざマクロを使うこともないと思いますが……

(1)Sheet1のA/B列を選択・コピー
(2)Sheet2に貼り付け
(3)Sheet2のB列をキーに、重複の削除

これだけです。どうしてもマクロでやりたければ、この操作をマクロ記録すればいいでしょう。

回答No.3

imogasi

シート2の、もし手入力する場合の、考えとデータを実例で説明してみてください。質問が回りくどい。
「シート1のA列において重複しないものをシート2に持って来たい」と言うことだけじゃないの？
シート1A列の　1ペン　１２３の１ペンの前の１は行番号か、ペンの種類を表すのか、判りにくいよ。
行番号だとすれば
データーフィルターフィルタオプションの設定ー重複するレコードは無視する、で重復亡き者が出せる。
関数ではGoogleで「imogasi方式」で照会すれば、たくさん回答している。
例データ　Sheet1
A-D列
製品 種類 結合 初出連番
ペン 123 ペン123 1
ペン 233 ペン233 2
ペン 123 ペン123
ペン 222 ペン222 3
紙 111 紙111 4
紙 111 紙111
紙 231 紙231 5
ーー
C2の式は　=A2&B2　以下式を複写
D2の式は　=IF(COUNTIF($C$2:C2,C2)=1,MAX($D$1:D1)+1,"")
Sheet2へ行って
A2の式　=INDEX(Sheet1!$A$1:$B$100,MATCH(ROW()-1,Sheet1!$D$1:$D$100,0),COLUMN())
B2へ式複写。
A2:B2の式を下方向に式複写。
結果　Sheet2　A2:B６
ペン 123
ペン 233
ペン 222
紙 111
紙 231
Sheet1のC列の結合方法は場合によっては適当でないケースがあるが
質問者がどういう場合か考えるkと。当社の場合は問題ない場合も大いにありえる。
Sheet2の沢山の行に式複写すると、エラーが出るが、出さない方法は、上記WEBを見ること。
その要点は、Sheet2の現在行数が、Sheet1のD列の最大値を超えたら、空白を出すようにIF分を前にかぶせる。
質問文が判りにくいので、見当ハズレなら本回答を無視すること。

お礼

imogasi様　こんにちは。

文章が分かりにくく申し訳ありません。

＞シート1A列の　1ペン　１２３の１ペンの前の１は行番号か、ペンの種類を表すのか、判りにくいよ。
　行番号です。

作業として行いたいのは、シート1からシート2へ登録する時
すでにシート２に入力されているものは入力を行わない。
シート1内で重複が無いとしても、以前にシート2に登録されていれば
その項目は登録を行わない。

例えば
A社の納品書をまずシート1としてシート2のリストへ登録していく。
この時、重複しているものがあれば登録を行わない。
次にB社の納品書をシート1としてシート2に登録していく。
B社の納品書の中に、先にA社の納品書からシート2のリストへ登録したものがあれば登録しない。
もちろんB社の納品書内で重複があれば登録しない。
次にC社・・・
というように
A・B・C社から同じものが納入されている状況で
シート2に作成しているリストは「新商品」のみの
登録を行っていきたいのです。

私の文章力ではこのようにしか表現できません。
お手数でなければ再度ご教授いただければと思います。

回答No.2

xls88

＞条件をIF文で書いているのですが、重複するものの判定がうまくいかず困っています。
試されているコードを提示されて相談された方が良いと思います。

色々やり方はあると思います。
下記、ワークシート関数を使った一例です。

Dim r As Range

For Each r In Sheets("シート1").Range("B1:B5")
If WorksheetFunction.CountIf(Sheets("シート2").Range("B1:B5"), r.Value) > 0 Then
MsgBox r.Value & " ： " & "重複しています"
Else
MsgBox r.Value & " ： " & "重複していません"
End If
Next

回答No.1

yokomaya

シート２の登録有無を考えて一件ずつ処理すれば重複は考慮不要では？