VBAマスターの方のお力をお借りしたいです。

画像
補足

言葉足らずで申し訳ありません。 この場合結果に浜田001〜浜田003は無いのでリストの色付けとsheet3への取得は行わないものとしたいです。 可能でしょうか?

Visual Basic206閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0

ID非公開

2021/7/30 8:52

ID非公開

2021/7/30 9:15

キーの比較に高速のDictionaryを使いましたが、普通の配列でも出来ます。その方がわかりやすければコードを変更しますが、一度テストしてみて結果をお知らせ下さい。

その他の回答(1件)

0

Sub testtt() Dim i Dim MaxRow1, MaxRow2, MaxRow3 Dim Cnt Dim S1, S2, S3 Set S1 = Worksheets("Sheet1") Set S2 = Worksheets("Sheet2") Set S3 = Worksheets("Sheet3") 'シート1にあって、シート2に無いなら色付け S1.Cells.Interior.ColorIndex = xlNone MaxRow1 = S1.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To MaxRow1 MaxRow3 = S3.Cells(Rows.Count, 1).End(xlUp).Row Cnt = WorksheetFunction.CountIf(S2.Range("A:A"), S1.Cells(i, 1)) If Cnt = 0 Then S1.Cells(i, 1).Interior.Color = vbYellow S3.Cells(MaxRow3 + 1, 1) = S1.Cells(i, 1) End If Next i 'シート2にあって、シート1に無いなら色付け S2.Cells.Interior.ColorIndex = xlNone MaxRow2 = S2.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To MaxRow2 MaxRow3 = S3.Cells(Rows.Count, 1).End(xlUp).Row Cnt = WorksheetFunction.CountIf(S1.Range("A:A"), S2.Cells(i, 1)) If Cnt = 0 Then S2.Cells(i, 1).Interior.Color = vbYellow S3.Cells(MaxRow3 + 1, 1) = S2.Cells(i, 1) End If Next i End Sub シート1・シート2はA列にデータが入っているものとし、各シートで該当したデータを、シート3のA列に転記しています。

この返信は削除されました