COUNTIF（）在'For'循环中
我有一个近100k列，并试图确定在该列中重复出现多less次值。 我现在可以一行一行地做，但是这是一个程序员，通过像= COUNTIF（D：D，D2）这样的东西。 然而，只有在D列返回D2的匹配。
我需要迭代D返回countif的所有值，因此揭示列中的所有值的重复。 我可以稍后删除重复项 所以我有一个开发。 button的基本子，或function（这对我来说是新的），并沿着最基本的循环线的东西。 刚好赶上如何实现COUNTIF（）正确的循环。
现在我正在看：
Sub doloop() Dim i As Integer i = 1 Do While i < D.Length Cells(i, 8).Value =CountIf(D:D,D[i]) i = i + 1 Loop End Sub 这段代码显然是不正确的，但它是我所在的地方，可能会帮助更熟悉其他语言的人。
在循环中使用Application.WorksheetFunction.CountIf（）。
Private Sub doloop() Dim lastRow As Long Dim d As Double Dim r As Range Dim WS As Excel.Worksheet Dim strValue As String Dim lRow As Long 'Build your worksheet object Set WS = ActiveWorkbook.Sheets("sheet1") 'Get the last used row in column A lastRow = WS.Cells(WS.Rows.count, "D").End(xlUp).Row 'Build your range object to be searched Set r = WS.Range("D1:D" & lastRow) lRow = 1 WS.Activate 'Loop through the rows and do the search Do While lRow <= lastRow 'First, get the value we will search for from the current row strValue = WS.Range("D" & lRow).Value 'Return the count from the CountIf() worksheet function d = Application.worksheetFunction.CountIf(r, strValue) 'Write that value to the current row WS.Range("H" & lRow).Value = d lRow = lRow + 1 Loop End Sub
我相信你正在努力把价值写入单元格，这就是上面所说的。 仅供参考，如果你想把一个公式放入单元格，这是怎么做的。 用这个代替WS.Range("H" & lRow).Value = d
WS.Range("H" & lRow).Formula = "=CountIf(D:D, D" & lRow & ")"
听起来就像你可能想在Excel中使用表格，并利用他们的function，如过滤和方程自动填充。 您可能也有兴趣使用数据透视表来做一些与您所描述的内容非常相似的内容。
如果你真的想要这个程序化的方式，我认为解决scheme马特给出的答案是如何使用CountIf做到这一点的问题。 使用CountIf有很大的不利之处，因为它在计算上不是很有效。 我不认为马特公布的代码真的是可行的处理OP中提到的100K行（Application.ScreenUpdating = false会帮助一些）。 这是另一种更有效率的方法，但不那么直观，所以你必须决定什么套房你的需求和你觉得符合什么。
Sub CountOccurances() 'Define Input and Output Ranges 'The best way to do this may very from case to case, 'So it should be addressed seperately 'Right now we'll assume current sheet rows 1-100K as OP specifies Dim RInput, ROutput As Range Set RInput = Range("D1:D100000") Set ROutput = Range("E1:E100000") 'Define array for housing and processing range values Dim A() As Variant ReDim A(1 To RInput.Rows.Count, 0) 'Use Value2 as quicker more accurate value A = RInput.Value2 'Create dictionary object Set d = CreateObject("Scripting.Dictionary") 'Loop through array, adding new values and counting values as you go For i = 1 To UBound(A) If d.Exists(A(i, 1)) Then d(A(i, 1)) = d(A(i, 1)) + 1 Else d.Add A(i, 1), 1 End If Next 'Overwrite original array values with count of that value For i = 1 To UBound(A) A(i, 1) = d(A(i, 1)) Next 'Write resulting array to output range ROutput = A End Sub
您也可以修改这个以包括删除您提到的重复项。
Sub CountOccurances_PrintOnce() 'Define Input and Output Ranges 'The best way to do this may very from case to case, 'So it should be addressed seperately 'Right now we'll assume current sheet rows 1-100K as OP specifies Dim RInput, ROutput As Range Set RInput = Range("D1:D100000") Set ROutput = Range("F1:F9") 'Define array for housing and processing range values Dim A() As Variant ReDim A(1 To RInput.Rows.Count, 0) 'Use Value2 as quicker more accurate value A = RInput.Value2 'Create dictionary object Set d = CreateObject("Scripting.Dictionary") 'Loop through array, adding new values and counting values as you go For i = 1 To UBound(A) If d.Exists(A(i, 1)) Then d(A(i, 1)) = d(A(i, 1)) + 1 Else d.Add A(i, 1), 1 End If Next 'Print results to VBA's immediate window Dim sum As Double For Each K In d.Keys Debug.Print K & ": " & d(K) sum = sum + d(K) Next Debug.Print "Total: " & sum End Sub