Question

自从我和VBA合作以来已经有一段时间了，所以请耐心等待，因为我可能会有点生疏。

我有2张桌子。一个是我称之为“已删除”列表，其中包含几列，另一个是包含所有详细信息的更详细列表。我想要做的是在“已删除”列表中查找项目（参见表1），如果一行中的所有项目都与主列表中的相关项目匹配（请参阅表2），则删除该行。我不能只做第一列，因为数据结构不是很好。

表1（已删除）

+-------------------+---------+-----------------+-----------------------+----------+
|       Name        | Source  |     Tel No      |       Address 1       | Postcode |
+-------------------+---------+-----------------+-----------------------+----------+
| A N OTHER         | MySrc   | 01234 123456    | 18 FAKE STREET        | XXX XXXX |
| A N OTHER         | MySrc2  | 01234 567890    | 29 FAKE STREET        | XXX XXXX |
+-------------------+---------+-----------------+-----------------------+----------+

表2（主要）

+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+
| Name          | Title | Full Name | Job Title |  Tel No       | Tel No 2    |  Address Line 1   | Address Line 2 | Address Line 3 | Address Line 4 | Postcode |   Data 1    |   Data 2    | Data 3 | Data 4 | Data 5 | Data 6 | Data 7 | Data 8 | Date Added | Source |
+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+
|  AN OTHER     |       | Person A  |           | 01234 123456  |             | 18 FAKE STREET    |                |                |                | XXX XXXX |             |             |        |        |        |        |        |        |            | MySrc  |
|  AN OTHER     |       | Person B  |           | 01234 999999  |             | 18 FAKE STREET    |                |                |                | XXX XXXX |             |             |        |        |        |        |        |        |            | MySrc  |
|... about another 5000 rows...
+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+

从中可以看出，它应该删除第1行但是留下第2行。

我有以下我编写的VBA代码，它目前只根据一列找到存在重复项的行。

Sub createFinalList() Dim rng As Range, Dim r As Range Dim wsFinal As Worksheet, wsOriginal As Worksheet, wsDelete As Worksheet Set wsFinal = ThisWorkbook.Sheets("FinalList") Set wsOriginal = ThisWorkbook.Sheets("List") Set wsDelete = ThisWorkbook.Sheets("PermaDelete") For i = wsDelete.UsedRange.Rows.Count To 2 Step -1 Set r = wsOriginal.Columns(1).Find(wsDelete.Cells(i, 1).Value, , xlValues, xlWhole, xlByRows, xlNext) If Not r Is Nothing Then firstA = r.Address Set rng = Nothing Do If rng Is Nothing Then Set rng = wsOriginal.Rows(r.Row) Else Set rng = Union(r, rng) End If Set r = wsOriginal.Columns(1).Find(wsDelete.Cells(i, 1).Value, r, xlValues, xlWhole, xlByRows, xlNext) Debug.Print r.Address Loop Until firstA = r.Address End If Next i End Sub

我想要做的是在删除最终结果之前对.Find rng使用每个后续列的{{1}}，但看起来应该有更简单的方法。我错过了一招吗？有更简单的方法吗？

Answer 1

如果您的“已删除”数据与“主要”数据完全一致，则可以使用 AdvancedFilter 。在此处阅读有关高级过滤器的更多信息：http://www.excel-easy.com/examples/advanced-filter.html HTH

Sub createFinalList()
    Dim mainSheet As Worksheet
    Dim criteriaSheet As Worksheet

    Set mainSheet = ThisWorkbook.Worksheets("Main")
    Set criteriaSheet = ThisWorkbook.Sheets("Deleted")

    Dim mainRange As Range
    Dim criteriaRng As Range

    Set mainRange = mainSheet.Range("A2:U3")
    Set criteriaRng = criteriaSheet.Range("A1:E3")

    mainRange.AdvancedFilter _
        Action:=xlFilterInPlace, _
        criteriaRange:=criteriaRng, _
        Unique:=False

    ' Delete rows hidden by advanced filter
    Dim myRow As Range
    Dim toDelete As Range

    For Each myRow In mainRange.Rows
        If myRow.EntireRow.Hidden Then
            If toDelete Is Nothing Then
                Set toDelete = myRow
            Else
                Set toDelete = Union(toDelete, myRow)
            End If
        End If
    Next

    If Not toDelete Is Nothing Then _
        toDelete.Delete
End Sub

Answer 2

你能做一个非VBA方法吗？它总是与您查找的列相同？

在＆＃34;删除＆＃34;中创建所有列的复合列表＆＃34; = a1＆amp; b1＆amp; c1＆＃34; ...
进行类似的＆＃34;查找＆＃34;主表上的专栏
在主表中添加一个标志列，执行vlookup＆＃34; = vlookup（c1，deletedrowslookupcolumn，1，false）＆＃34;
过滤您的标志栏
删除已过滤的行

Answer 3

我通过与@mlinth得出相同的结论并使用了.Find方法中使用的连接字符串。我在表2的末尾添加了一列，它是与表1相同顺序的所需列的串联。此外，我可以在那里删除整行然后，因此必须修改我的.Find循环中的语句，因此它不再从r（刚被删除）

开始

Dim r As Range
Dim wsOriginal As Worksheet, wsDelete As Worksheet
Set wsOriginal = ThisWorkbook.Sheets("List")
Set wsDelete = ThisWorkbook.Sheets("PermaDelete")
Dim str As String
For i = wsDelete.UsedRange.Rows.Count To 2 Step -1
    str = wsDelete.Cells(i, 1).Value & wsDelete.Cells(i, 2).Value & wsDelete.Cells(i, 3).Value & wsDelete.Cells(i, 4).Value & wsDelete.Cells(i, 5).Value
    Set r = wsOriginal.Columns(30).Find(str, , xlValues, xlWhole, xlByRows, xlNext)
    Do until r Is Nothing Then
        wsOriginal.Rows(r.Row).EntireRow.Delete
        Set r = wsOriginal.Columns(30).Find(str, , xlValues, xlWhole, xlByRows, xlNext)
    Loop
Next i

如果条目与另一个表重复，则从表中删除行

3 个答案: