プロが教えるわが家の防犯対策術!

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

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

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

A 回答 (5件)

やり方は、星の数ほどあるでしょうが(大げさ)、最近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
    • good
    • 0
この回答へのお礼

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

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

お礼日時:2009/07/06 23:56

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



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

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

シート2の、もし手入力する場合の、考えとデータを実例で説明してみてください。

質問が回りくどい。
「シート1のA列において重複しないものをシート2に持って来たい」と言うことだけじゃないの?
シート1A列の 1ペン 123の1ペンの前の1は行番号か、ペンの種類を表すのか、判りにくいよ。
行番号だとすれば
データーフィルターフィルタオプションの設定ー重複するレコードは無視する、で重復亡き者が出せる。
関数ではGoogleで「imogasi方式」で照会すれば、たくさん回答している。
例データ Sheet1
A-D列
製品種類結合初出連番
ペン123ペン1231
ペン233ペン2332
ペン123ペン123
ペン222ペン2223
紙111紙1114
紙111紙111
紙231紙2315
ーー
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:B6
ペン123
ペン233
ペン222
紙111
紙231
Sheet1のC列の結合方法は場合によっては適当でないケースがあるが
質問者がどういう場合か考えるkと。当社の場合は問題ない場合も大いにありえる。
Sheet2の沢山の行に式複写すると、エラーが出るが、出さない方法は、上記WEBを見ること。
その要点は、Sheet2の現在行数が、Sheet1のD列の最大値を超えたら、空白を出すようにIF分を前にかぶせる。
質問文が判りにくいので、見当ハズレなら本回答を無視すること。
    • good
    • 0
この回答へのお礼

imogasi様 こんにちは。

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

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

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

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

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

お礼日時:2009/07/05 11:39

>条件を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
    • good
    • 0

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

    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!