VBA 计算字符串列表中的出现次数

VBA counting number of occurrences in a list of strings

我在 excel 的单列中列出了 1000 多个名字,这些名字偶尔会重复。我正在尝试计算每个名称出现的次数。这就是我目前所拥有的,它填充了所需的 sheet 但是在计算名称出现的次数时它似乎搞砸了。任何帮助!

m = 2
n = 1

    person = Worksheets("Sheet1").Cells(m, 6).Value
    Worksheets("Sorted_Data").Cells(n, 2).Value = person
    Worksheets("Sorted_Data").Cells(n, 3).Value = 1
    n = n + 1
    m = m + 1
    
    For i = 0 To Total_Tickets
        person = Worksheets("Sheet1").Cells(m, 6).Value
        y = 1
        d = 0
        Do While d <= i
            comp = Worksheets("Sorted_Data").Cells(y, 2).Value
            x = StrComp(person, comp, vbTextCompare)
            If x = 0 Then
                Worksheets("Sorted_Data").Cells(n - 1, 3).Value = Worksheets("Sorted_Data").Cells(n - 1, 3).Value + 1
                m = m + 1
                d = 10000
            ElseIf x = 1 Or x = -1 Then
                If comp = "" Then
                    Worksheets("Sorted_Data").Cells(n, 2).Value = person
                    Worksheets("Sorted_Data").Cells(n, 3).Value = 1
                    n = n + 1
                    m = m + 1
                    d = 10000
                End If
                y = y + 1
                d = d + 1
            End If
        Loop
        Next i

你在那里管理了很多计数器,这使得逻辑更难理解。

你可以考虑这样的事情:

Sub Tester()
    
    Dim wsData As Worksheet, wsList As Worksheet, arr, m, i As Long, nm
    
    Set wsData = ThisWorkbook.Sheets("Sheet1")
    Set wsList = ThisWorkbook.Sheets("Sorted_Data")
    
    'grab all the names in an array
    arr = wsData.Range("A2:A" & wsData.Cells(Rows.Count, "A").End(xlUp).Row).Value
    
    For i = 1 To UBound(arr, 1) 'loop over the array
        nm = arr(i, 1)          'grab the name
        m = Application.Match(nm, wsList.Columns("A"), 0)  'existing name on the summary sheet?
        If IsError(m) Then
            'name was not found: add it to the summary sheet
            With wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1)
                .Value = nm
                m = .Row
            End With
        End If
        With wsList.Cells(m, "B")
            .Value = .Value + 1 'update the count
        End With
    Next i
    
End Sub