2 つのリストがあり、それぞれが独自のシートにあります。
私の目標は、最初のシートの各セルで2番目のシートの各セルを検索し、見つかった場合は最初のシートの行全体を削除することです。
セルの内容は必ずしも同じではなく、文字列のみです。
たとえば、シート 2 のセルの 1 つが「string」ですが、最初のシートのセルの 1 つが「substring」の場合、最初のシートの行全体を削除する必要があります。
VBA経由でどのようにアプローチすればよいですか?
ありがとうございました!
2 つのリストがあり、それぞれが独自のシートにあります。
私の目標は、最初のシートの各セルで2番目のシートの各セルを検索し、見つかった場合は最初のシートの行全体を削除することです。
セルの内容は必ずしも同じではなく、文字列のみです。
たとえば、シート 2 のセルの 1 つが「string」ですが、最初のシートのセルの 1 つが「substring」の場合、最初のシートの行全体を削除する必要があります。
VBA経由でどのようにアプローチすればよいですか?
ありがとうございました!
「ワンショット」操作の場合は、「VLOOKUP」を実行し、フィルターを使用して見つかった文字列を削除します。
VBAでは、次のようなものでそれを行います:
for i = 1 to 65535
for j = 1 to 65535
if sheets("sheet1").range("A" & i).value = sheets("sheet2").range("A" & j).value then
sheets("sheet1").range("A" & i).EntireRow.Delete
end if
next j
next i
シート 2 の列の各セルについて、シート 1 の列で部分一致を探します。一致する場合は行全体を削除し、一致が見つからなくなるまで繰り返します。
これは、リストが各シートの 1 列に編成されていることを前提としています。
Sub InCellDeDupe()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim foundRow As Range
Dim r As Long
Dim cl As Range
Dim str As String
Set sh1 = Worksheets("Sheet 1") '<-- modify as needed
Set sh2 = Worksheets("Sheet 2") '<-- modify as needed
Set rng1 = sh1.UsedRange.Columns(1) '<-- modify as needed
Set rng2 = sh2.UsedRange.Columns(1) '<-- modify as needed
For Each cl In rng2
str = cl.Value
Do
Set foundRow = rng1.Find(What:=str, After:=rng1.Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not foundRow Is Nothing Then
foundRow.EntireRow.Delete
Else:
Exit Do
End If
Loop
Next
End Sub
以下のコードを試してください:
Sub sample()
Dim lastRowSheet1 As Long, lastRowSheet2 As Long, rng As Range, r As Range, i As Integer, j As Integer
lastRowSheet2 = Sheets("Sheet2").Range("A65000").End(xlUp).Row ' total row sheet 2
lastRowSheet1 = Sheets("Sheet1").Range("A65000").End(xlUp).Row ' total row sheet 1
For j = 1 To lastRowSheet2 'loop thru every cell of sheet 2
For i = 1 To lastRowSheet1 ' loop thru every cell of sheet 1
If InStr(1, Sheets("Sheet1").Cells(i, 1).Value, Sheets("Sheet2").Cells(j, 1).Value) > 0 Then
Sheets("Sheet1").Cells(i, 1).EntireRow.Delete
Exit For
End If
Next
Next
End Sub
mansuetus が提案した方法は、65k 行すべてを 65k 回反復する必要があり、部分文字列が見つからないため、非常に遅くなります。
パフォーマンスを向上させるには、データの長さを動的に検索して保存する必要があります。部分文字列を検索する問題については、次のようなものを使用できます。
If FullCellString = LookupStr Then
'Match found - delete row
Else
If InStr(1, FullCellString, LookupStr, vbTextCompare) > 0 Then
'Match found in substring delete row
End If
End If