Excel VBA以2列或更多列的组合查找唯一值
我试图用for循环创build一个模块来计算3个合并列的唯一值，包含付款date，月份和date的状态。 所述date是分开的，因为它们中的每一个都是指月份的一个周期，并且按照该确切顺序按年，月和日sorting。 像下面的简单小例子一样。
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个案例，我只是计算它看看有多less独特的价值，我有这个date，并保存在一个单独的工作表。 如果在任何情况下都不相同，只需将date添加到第二个工作表并从那里开始计算。 下面的代码是为了方便而简化的，因为我正在处理的macros太大而不能在这里发布。 编辑：如果需要我可以上传完整的代码的地方，我只是要翻译一些变数和意见。
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
我所得到的通常是第一次把所有数据都logging在新表单中的第一行，以及第二行最后一行的数据。
我也尝试使用字典和/或集合，但是即使在堆栈溢出和互联网上find的一些例子，我也不太了解它们的概念。
我如何使这个循环工作，或者什么会是一个更好的方式来做到这一点？
要从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
注意：
您可以根据需要将方法扩展为尽可能多的列：
- 连接列
- 使用function区的“ 数据”选项卡中的“ 删除重复项”function
编辑＃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中）：
=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