Excel-VBA：計算不同字符串的出現次數並列出它們

Question

今天，我遇到了以下問題：我在Excel中有2列x行（無所謂），每行各有一個字符串，像這樣

   A                B
 Apple            Potato
 Banana           Potato
 Apple            Potato
 Orange           Apple

每個字符串都可以出現在兩列中。

我需要獲得以下結果：

Fruit          Occurrencies
Apple               3
Banana              1
Potato              3
Orange              1

現在，我可以肯定地知道，有一個比我想像的要快得多的方法，感謝您能提供的任何幫助。 我的解決方案包括將字符串逐一存儲在數組中，每次檢查字符串是否已包含在當前字符串之前的插槽中，如果不是，則還要計算其出現次數。 例如，在將所有字符串存儲在數組中之后（我現在將其稱為Fruit() ）：

Dim Str() As Variant
Dim Flag As Boolean

For i = LBound(Fruit)+1 to Ubound(Fruit)
    Flag = True
    For j = i to LBound(Fruit)
        If Fruit(i) = Fruit(j) Then
            Flag = False
            Exit For
        End If
    Next
    If Flag = True Then
        Str(k,0) = Fruit(i)
        For y = LBound(Fruit) to UBound(Fruit)
            if Str(k,0) = Fruit(y) Then Str(k,1) = Str(k,1)+1
        Next
        k = k+1
    End If
Next

這簡直太瘋狂了，我知道有一個更簡單的解決方案……我只是找不到。

Answer 1

您可以使用字典對象，對我來說看起來很簡單

Sub fruitsCount()

    Dim sourceRange As Range
    Dim sourceMem As Object
    Dim curRow as integer

    'CHANGE TO WHATEVER SHEET NAME YOUR ARE USING
    With Worksheets("SOURCE_SHEET")
        Set sourceRange = .Range("A1:B" & .Range("A" & .Rows.count).End(xlUp).row)
    End with

    Set sourceMem = CreateObject("Scripting.dictionary")

    For Each cell In sourceRange
        On Error GoTo ERREUR
        sourceMem.Add cell.Value, 1
        On Error GoTo 0
    Next

    curRow = 2

    'CHANGE TO WHATEVER SHEET NAME YOUR ARE USING
    With Worksheets("DESTINATION_SHEET")
        .Range("A1").Value = "Fruit"
        .Range("B1").Value = "Occurencies"
        For Each k In sourceMem.Keys
            .Range("A" & curRow).Value = k
            .Range("B" & curRow).Value = sourceMem(k)
            curRow = curRow + 1
        Next k
    End With

    Set sourceMem = Nothing

    Exit Sub

ERREUR:

    sourceMem(cell.Value) = sourceMem(cell.Value) + 1
    Resume Next

End Sub

編輯：代碼背后的邏輯實際上非常簡單，並且依賴於允許收集（鍵，值）對的字典對象。 這里的鍵將是水果名稱，值是每個水果的出現次數。 代碼所依賴的字典對象的獨特功能是它不允許重復的鍵-每當您嘗試添加字典中已存在的鍵時，都會發出運行時錯誤。

因此，代碼僅掃描源范圍的每個單元格，並嘗試將其值添加為字典的鍵：

• 如果操作成功，則這是該水果在源范圍中的第一次出現-將其作為鍵添加到字典中，並且其配對值設置為1
• 否則，該水果已經作為字典中的鍵存在-從而在嘗試將水果添加到字典中時發生錯誤。 然后，代碼跳轉到ERREUR錯誤處理程序，以增加與字典中現有水果鍵配對的值，並從那里恢復正常執行

希望有助於澄清

Answer 2

確認您的答案正確無誤，並為+1尋求幫助，但我也想與社區分享為使這項工作適用於陣列而付出的努力：

Private Function FilesCount(SourceRange As Range) As Variant

    Dim SourceMem As Object
    Dim Occurrencies() As Variant
    Dim OneCell As Range
    Dim i As Integer

    Set SourceMem = CreateObject("Scripting.dictionary")

    For Each OneCell In SourceRange
        On Error GoTo Hell
        SourceMem.Add OneCell.Value, 1
        On Error GoTo 0
    Next

    ReDim Occurrencies(SourceMem.Count - 1, 1)

    For i = 0 To SourceMem.Count - 1
        Occurrencies(i, 0) = SourceMem.Keys()(i)
        Occurrencies(i, 1) = SourceMem.Items()(i)
    Next i

    Set SourceMem = Nothing

    FilesCount = Occurrencies

    Exit Function

Hell:

    SourceMem(OneCell.Value) = SourceMem(OneCell.Value) + 1
    Resume Next

End Function

它返回一個（nx 2）數組，其中有n個名稱及其在選定范圍內的出現