☰

在工作表中创建唯一组合列表

tag-icon • tag-icon microsoft-excel
在工作表中创建唯一组合列表

我有一个很大的 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

方法：

  1. 添加一列，其中包含每行 5 列的连接
  2. 让代码从下往上工作，在新列中查找重复项

假设数据如下：

在此处输入图片描述

在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

最终结果为：

在此处输入图片描述

您甚至不需要先对数据进行排序！

相关内容