Sub 検索追記() ' Dim ws01 As Worksheet Dim HIKAKU As Range Dim KEN01, KEN02, TSUIKA, i As Long Set ws01 = Worksheets("Sheet1") 'ワークシートの設定 KEN01 = ws01.Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行を設定する KEN02 = ws01.Cells(Rows.Count, "F").End(xlUp).Row 'F列の最終行を設定する。 TSUIKA = KEN01 + 1 'B列の追加する行を指定します。 For i = 2 To KEN02 Set HIKAKU = ws01.Columns("B").Find(What:=ws01.Cells(i, "F"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) 'B列とF列を比較する。 If HIKAKU Is Nothing Then '比較して無い場合は、下記を実行 ws01.Cells(TSUIKA, "A") = ws01.Cells(i, "E") '追加する文字を転記する。(コード) ws01.Cells(TSUIKA, "B") = ws01.Cells(i, "F") '追加する文字を転記する。(都道府県) ws01.Range("B" & TSUIKA).Interior.ColorIndex = 6 '追加した都道府県名を塗りつぶす(黄色) TSUIKA = TSUIKA + 1 '追加する件数毎に+1加算する。(追加行) End If Next i 'F列データの最終行までループ ws01.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous '罫線を引きなおす。 End Sub