![在工作表中创建唯一组合列表](https://linux22.com/image/1537639/%E5%9C%A8%E5%B7%A5%E4%BD%9C%E8%A1%A8%E4%B8%AD%E5%88%9B%E5%BB%BA%E5%94%AF%E4%B8%80%E7%BB%84%E5%90%88%E5%88%97%E8%A1%A8.png)
我有一个很大的 Excel 文件,里面有数千行测试数据。我已按列中的标识符对它们进行排序,并试图找出已运行的重复测试。
每行有 5 列,其中包含我关心的数据。有人能帮我写一个 VBA 宏来查找具有这些测试唯一组合的行,并生成工作表中存在的不同组合的列表吗?理想情况下,我希望此列表显示在单独的工作表上。
我不希望这些数据放在数据透视表中,因为表太大而无法从中推断出任何信息。
我尝试过连接函数,但由于某些列缺少数据,它无法执行我需要的操作。我附上了我一直试图修改的代码,这是我在另一篇文章中找到的。我在最后的 If 语句中遇到了问题(我甚至不认为它会执行我想要的操作),因为我得到了类型不匹配错误。我是 VBA 新手,所以我遇到了很多问题。
谢谢!!
Sub GetCombinations()
Dim sheet1, sheet2 As Worksheet
Set sheet1 = Worksheets("Data")
Set sheet2 = Worksheets("Sort")
Dim sStartColumn As String
Dim iTopRow As Long
Dim sEndColumn As String
Dim iBottomRow As Long
sStartColumn = "AS"
iTopRow = 6
sEndColumn = "AU"
iBottomRow = sheet1.UsedRange.Rows.Count
Dim Rng As Range
Dim sRange1 As String
sRange1 = sStartColumn & CStr(iTopRow) & ":" & sEndColumn & CStr(iBottomRow)
Set Rng = sheet1.Range(sRange1)
Rng.Sort Key1:=Range("AS6"), Order1:=xlAscending, _
Key2:=Range("AU1203"), Order2:=xlAscending, _
Orientation:=xlSortColumns, Header:=xlYes
Dim j As Integer
Dim i As Integer
j = 2
For i = 7 To iBottomRow
If sheet1.Cells(i, 45) Then
sheet2.Cells(j, 1) = sheet1.Cells(i, 1)
sheet2.Cells(j, 2) = sheet1.Cells(i, 2)
sheet2.Cells(j, 3) = sheet1.Cells(i, 5)
j = j + 1
End If
Next i
子目录结束
答案1
方法:
- 添加一列,其中包含每行 5 列的连接
- 让代码从下往上工作,在新列中查找重复项
假设数据如下:
在F1进入:
=A1 & CHAR(1) & B1 & CHAR(1) & C1 & CHAR(1) & D1 & CHAR(1) & E1
并复制下来。然后运行:
Sub De_Dup()
Dim i As Long, N As Long, wf As WorksheetFunction
Dim r1 As Range, r2 As Range
N = Cells(Rows.Count, "F").End(xlUp).Row
Set wf = Application.WorksheetFunction
For i = N To 2 Step -1
Set r1 = Cells(i, "F")
Set r2 = Range(Range("F1"), Cells(i - 1, "F"))
If wf.CountIf(r2, r1.Value) > 0 Then r1.EntireRow.Delete
Next i
End Sub
最终结果为:
您甚至不需要先对数据进行排序!