Excel VBA在2个或更多列的组合中查找唯一值

我试图创建一个带有for循环的模块，以计算包含付款日期、月份和日期年份状态的3个组合列的唯一值。所说的日期是分开的，因为它们都是指一个月的周期，所有的事情都是按年、月、日的顺序进行排序的。如下面的简化小示例

STATUS: DAY : MONTH : YEAR
PAID: 1   : 7     : 2016
OPEN: 1   : 7     : 2016
PAID: 1   : 7     : 2016
OPEN: 5   : 7     : 2016
PAID: 5   : 7     : 2016
OPEN: 5   : 7     : 2016
PAID: 10  : 7     : 2016
OPEN: 10  : 7     : 2016
PAID: 10  : 7     : 2016
PAID: 15  : 7     : 2016
PAID: 15  : 7     : 2016
OPEN: 15  : 7     : 2016

我试图做的是将所有3个单元格与列中的下一个单元格进行比较，如果它们在所有3种情况下都相等，我只需数一数，看看我在这个日期有多少个唯一的值，并将其保存在单独的表格中。如果在任何情况下都不一样，只需将日期添加到第二张纸上，然后从那里开始计数。为了方便起见，下面的代码被简化了，因为我正在处理的宏太大了，无法在这里发布。 编辑：如果需要，我可以上传完整的代码到某处，我会翻译一些变量和注释

j = 3 '' variable referencing the next line after i
k = 1 '' variable referencing the lines of the second sheet.
For i = 2 To lastrow ''variable to count how many rows the first sheet has

    j = j + 1 ''variable to check the very next line after i

    If w1.Range("A" & i).Value = "PAID" Then
        If w1.Range("H" & i).Value = w1.Range("H" & j) And w1.Range("G" & i).Value = w1.Range("G" & j) And w1.Range("F" & i).Value = w1.Range("F" & j) Then ''if statement to check if all 3 cells are equal to the next 3 cells 
            w2.Range("D" & K).Value = w2.Range("D" & K).Value + 1 '' Sum 1 to the total number of dates with equal parameters on the 3 cells


        Else '' writes the new date in the second sheet
            K = K + 1
            w2.Range("A" & K).Value = w1.Range("H" & i).Value
            w2.Range("B" & K).Value = w1.Range("G" & i).Value
            w2.Range("C" & K).Value = w1.Range("F" & i).Value
            w2.Range("D" & K).Value = 1

        End If
    End If

Next i

我得到的通常是第一个日期，所有数据都在新工作表的一行上，最后一行的数据在第二行

我也尝试过使用字典和/或集合，但即使在堆栈溢出和internet上找到的一些示例中，我也没有完全理解它们的概念

---

我如何使这个循环工作，或者什么是更好的方法

要从4列中获取唯一的组合：

Sub uniKue()
    Dim i As Long, N As Long, s As String
    N = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To N
        Cells(i, 5) = Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
    Next i

    Range("E2:E" & N).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

注意：

您可以根据需要为任意多个列扩展该方法：

• 连接列
• 使用功能区数据选项卡中的RemovedUpplicates功能

编辑#1:

此版本：

Sub uniKue()
    Dim i As Long, N As Long, s As String, r As Range
    N = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To N
        Cells(i, 5) = Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
        Cells(i, 6) = Cells(i, 5)
    Next i

    Range("F:F").RemoveDuplicates Columns:=1, Header:=xlNo
    For Each r In Range("F:F").SpecialCells(2).Offset(, 1)
        r.Formula = "=COUNTIF(E:E," & r.Offset(, -1).Address & ")"
    Next r
End Sub

产生：

---

列E是完整的组合集。
列F是唯一的组合集。
列G是每个唯一项的出现次数。

一旦完成，列E就可以隐藏。

要从4列中获得唯一的组合：

Sub uniKue()
    Dim i As Long, N As Long, s As String
    N = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To N
        Cells(i, 5) = Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
    Next i

    Range("E2:E" & N).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

注意：

您可以根据需要为任意多个列扩展该方法：

• 连接列
• 使用功能区数据选项卡中的RemovedUpplicates功能

编辑#1:

此版本：

Sub uniKue()
    Dim i As Long, N As Long, s As String, r As Range
    N = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To N
        Cells(i, 5) = Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
        Cells(i, 6) = Cells(i, 5)
    Next i

    Range("F:F").RemoveDuplicates Columns:=1, Header:=xlNo
    For Each r In Range("F:F").SpecialCells(2).Offset(, 1)
        r.Formula = "=COUNTIF(E:E," & r.Offset(, -1).Address & ")"
    Next r
End Sub

产生：

---

列E是完整的组合集。
列F是唯一集。
列G是每个唯一项的出现次数。

一旦完成，列E可以隐藏。

要获得不同行数（8），可以使用此Excel公式（在VBA中）：

要获取没有重复项的唯一行数（4）：

---

在VBA中，可以使用以下方法计算Excel公式：

您还可以一次获取所有行的计数（比单独调用每个单元格的Excel更快）：

---

要获取不同行数（8），可以使用以下Excel公式（在VBA中也可以使用）：

要获取没有重复项的唯一行数（4）：

---

在VBA中，可以使用以下方法计算Excel公式：

您还可以一次获取所有行的计数（比单独调用每个单元格的Excel更快）：

---

我忘了在我的问题中提到，我需要对所述值显示的次数求和。我该怎么做？你需要计算每个独特组合在完整数据集中出现的次数吗？？？我需要显示我有多少不同的数据集，以及它们在数据集旁边出现的次数。@Otorinolaringologista man，看看你是否可以根据你的需要调整我的编辑#1。我忘了在我的问题中提到我需要对数据集进行求和所述值显示的次数。我该怎么做？你需要计算每个独特的组合在完整数据集中出现的次数吗？？？我需要显示我有多少不同的数据集，以及它们在旁边出现的次数。@Otorrinolaringologista man看看你是否可以根据你的需要调整我的编辑#1。我如何在VBA中应用这些？@Otorrinolaringologista man i我不确定您只需要计数还是行，所以我为这两个都添加了示例。如果您只需要付费状态计数，您可以将

A2:A3、A2:A3、

替换为

A2:A3、“，”付费“，

如何在VBA中应用它？@otorinolaringologista man我不确定您是否只需要计数或行，因此我添加了这两个示例。如果您只需要付费状态计数，您可以将

A2:A3、A2:A3、

替换为

A2:A3、“付费”

lastRow = Sheet1.Cells.CurrentRegion.Rows.Count

uniqueCount = Sheet1.Evaluate(Replace( _
      "SUM(--(COUNTIFS(A2:A3,A2:A3,B2:B3,B2:B3,C2:C3,C2:C3,D2:D3,D2:D3)=1))", 3, lastRow))

Debug.Print uniqueCount    ' 4

countsArray = Sheet1.Evaluate(Replace( _
      "Transpose(CountIfs(A2:A9,A2:A9,B2:B9,B2:B9,C2:C9,C2:C9,D2:D9,D2:D9))", 9, lastRow))

' Debug.Print Join(countsArray)   ' "2 1 2 2 1 2 2 1 2 2 2 1"
' Debug.Print Evaluate("SUM(--({" & Join(countsArray, ",") & "}=1))") ' 4
' Debug.Print Evaluate("SUM(1/{" & Join(countsArray, ",") & "})")     ' 8

For i = 2 To lastRow
    If countsArray(i - 1) = 1 Then
        ' ... no dumplicates
    Else
        ' .. has duplicates
    End If
Next i