如果条目复制另一个表，则从表中删除行 [英] Delete rows from table if entries duplicate another table
问题描述
我有2张桌子，因为我和VBA一起工作了一段时间。一个是我所谓的删除列表，其中有几列，另一个是更详细的列表，其中包含所有详细信息。我想做的是在删除列表中查找项目（见表1），如果一行中的所有项目与主列表中的相关项目相匹配（请参见表2），然后删除该行。
表1（已删除）
+ ------------------- + --------- + --------------- + ----------------------- + ---------- +
|名称|来源|电话号码|地址1 |邮政编码|
+ ------------------- + --------- + --------------- - + ----------------------- + ---------- +
| A N其他| MySrc | 01234 123456 | 18 FAKE STREET | XXX XXXX |
| A N其他| MySrc2 | 01234 567890 | 29 FAKE STREET | XXX XXXX |
+ ------------------- + --------- + --------------- - + ----------------------- + ---------- +
表2（主）
+ -------- + ------- + ----------- ---------- + - + --------------- + ------------- + ------------------ - + ---------------- + ---------------- -------------- + - + ---------- + ------------- ------------- + -------- + + -------- + -------- + -------- + -------- + -------- + ---- -------- + -------- +
|名称|标题|全名|职位|电话号码|电话号码2 |地址第1行|地址第2行|地址第3行|地址第4行|邮政编码|数据1 |数据2 |数据3 |数据4 |数据5 |数据6 |数据7 |数据8 |添加日期|来源|
+ --------------- + ------- + ----------- + --------- - + --------------- + ------------- + ----------------- - + ---------------- + ---------------- + ------------- --- + ---------- + ------------- ------------- + ------- + - + -------- + -------- + -------- + -------- + -------- + --- --------- + -------- +
|其他| |人A | | 01234 123456 | | 18 FAKE STREET | | | | XXX XXXX | | | | | | | | | | MySrc |
|其他| |人B | | 01234 999999 | | 18 FAKE STREET | | | | XXX XXXX | | | | | | | | | | MySrc |
| ...关于另外5000行...
+ --------------- + ------- + ------ ----- + ----------- + -------- + ------------- + - ----------------- + ---------------- + --------------- - + ---------------- + ---------- + ------------- + ------ ------- -------- + -------- + -------- + -------- + ------ + - + -------- + ------------ + -------- +
从这里可以看出，它应该删除第1行，但是留下第2行。
我有以下VBA我写的代码，目前根据一列现在找到重复存在的行。
Sub createFinalList（）
Dim rng As Range，Dim r As Range
Dim wsFinal As Worksheet，wsOriginal As Worksheet，wsDelete As Worksheet
设置wsFinal = ThisWorkbook.Sheets finalList）
设置wsOriginal = ThisWorkbook.Sheets（List）
设置wsDelete = ThisWorkbook.Sheets（PermaDelete）
对于i = wsDelete.UsedRange.Rows .Count To 2 Step -1
设置r = wsOriginal.Columns（1） find（wsDelete.Cells（i，1）.Value，，xlValues，xlWhole，xlByRows，xlNext）
如果不是r是没有然后
firstA = r.Address
设置rng =没有
Do
如果rng不是，然后
设置rng = wsOriginal.Rows（r.Row）
Else
设置rng = Union（r，rng）
结束如果
设置r = wsOriginal.Columns（1）.Find（wsDelete.Cells（i，1）.Value，r，xlValues，xlWhole，xlByRows，xlNext）
Debug.Print r.Address
循环直到firstA = r.Address
结束如果
下一个i
结束Sub
我正在想的是在每个后续的 rng 中使用 .Find 在删除最终结果之前，列，但似乎应该有一个更简单的方法。我错过了一个技巧吗？是否有更简单的方法？
如果您的已删除数据与主数据完全相符，使用 AdvancedFilter 。请阅读有关高级过滤器的更多信息： http://www.excel-easy.com/ examples / advanced-filter.html HTH
Sub createFinalList（）
Dim mainSheet As Worksheet
Dim criteriaSheet As Worksheet
设置mainSheet = ThisWorkbook.Worksheets（Main）
设置criteriaSheet = ThisWorkbook.Sheets（Deleted）
Dim mainRange作为范围
Dim criteriaRng As Range
设置mainRange = mainSheet.Range（A2：U3）
设置criteriaRng = criteriaSheet.Range（A1：E3）
mainRange.AdvancedFilter _
动作：= xlFilterInPlace，_
criteriaRange：= criteriaRng，_
唯一：= False
'删除行隐藏通过高级过滤器
Dim myRow As Range
Dim toDelete As Range
对于每个myRow在mainRange.Rows
如果myRow.EntireRow.Hidden然后
如果toDel ete Is Nothing Then
Set toDelete = myRow
Else
设置为Delete = Union（toDelete，myRow）
如果
结束If
Next
如果不是删除没有，那么_
toDelete.Delete
End Sub
Been a while since I worked with VBA so bear with me as I may be a little bit rusty.
I have 2 tables. One is what I call a "Deleted" list with a few columns and the other is a more detailed list with all details. What I want to do is look up items on the "Deleted" list (see Table 1) and if all the items in a row match the relevant items in the main list (see Table 2), then delete the row. I cannot just do the first column, as data is not very well structured.
Table 1 (Deleted)
+-------------------+---------+-----------------+-----------------------+----------+
| 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 |
+-------------------+---------+-----------------+-----------------------+----------+
Table 2 (Main)
+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+
| 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...
+---------------+-------+-----------+-----------+---------------+-------------+-------------------+----------------+----------------+----------------+----------+-------------+-------------+--------+--------+--------+--------+--------+--------+------------+--------+
As you can see from this, it should delete line 1 but leave line 2.
I have the following VBA code that I have written, which currently finds the rows where the duplicates exist based on one column only.
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
What I was thinking of doing was then using .Find on rngfor each subsequent column before deleting the final result, however it does seem like there should be an easier way. Am I missing a trick? Is there an easier way to do this?
If your 'Deleted' data exactly correspond with the 'Main' data you could use AdvancedFilter. Read more about advanced filter here: 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
这篇关于如果条目复制另一个表，则从表中删除行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
