'For' 循环中的 COUNTIF()

Question

我有一列接近 100k，我试图确定一个值在该列中重复出现的次数。我目前可以逐行进行，但作为程序员，这很卑微，通过 =COUNTIF(D:D,D2) 之类的方法。然而，这只会在 D 列中返回 D2 匹配项。

我需要遍历 D 返回 countif 的所有值，因此显示列中的所有重复值。我可以稍后删除重复项！所以我有一个开发者。按钮一个基本的子或函数（这对我来说是新的）和一些类似于有史以来最基本的 for 循环的东西。刚刚了解如何正确实现 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

该代码显然不正确，但它是我所在的位置，并且可能对更熟悉其他语言的任何人有所帮助。

Answer 1

在循环中使用 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 & ")"

Answer 2

听起来您可能想研究在 Excel 中使用表格并利用它们的功能，例如过滤和方程式自动填充。您可能也有兴趣使用数据透视表来执行与您所描述的非常相似的事情。

如果您真的想以编程方式进行此操作，我认为 Matt 提供的解决方案可以回答您有关如何使用 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