Question

我正在尝试创建一个带有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

我得到的通常是第一个日期，新图表中的所有内容都计入一行，第二行中最后一行的数据也是如此。

我也尝试使用字典和/或集合，但即使在堆栈溢出和互联网上找到的一些例子我也没有完全理解它们。

如何使这个循环工作或者更好的方法呢？

Answer 1

要从 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

注意：

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

连接列

使用功能区的数据标签中的 RemoveDuplicates 功能

修改＃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 列。

Answer 2

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

=SUMPRODUCT(1 / COUNTIFS(A2:A13,A2:A13, B2:B13,B2:B13, C2:C13,C2:C13, D2:D13,D2:D13) )

获取不具有重复项的唯一行数（4）：

=SUMPRODUCT(--( COUNTIFS(A2:A13,A2:A13, B2:B13,B2:B13, C2:C13,C2:C13, D2:D13,D2:D13)=1 ))

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

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

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

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

Excel VBA以2列或更多列的组合查找唯一值

2 个答案: