0

2 つのリストがあり、それぞれが独自のシートにあります。

私の目標は、最初のシートの各セルで2番目のシートの各セルを検索し、見つかった場合は最初のシートの行全体を削除することです。

セルの内容は必ずしも同じではなく、文字列のみです。

たとえば、シート 2 のセルの 1 つが「string」ですが、最初のシートのセルの 1 つが「substring」の場合、最初のシートの行全体を削除する必要があります。

VBA経由でどのようにアプローチすればよいですか?

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

4

4 に答える 4

1

「ワンショット」操作の場合は、「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
于 2013-03-28T16:10:52.807 に答える
1

シート 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
于 2013-03-28T16:39:45.203 に答える
1

以下のコードを試してください:

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

ここに画像の説明を入力

于 2013-03-28T18:54:51.353 に答える
1

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
于 2013-03-28T16:43:07.620 に答える