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错误hanlder以增加与字典中现有的水果密钥配对的值，并从那里恢复正常执行

希望有助于澄清

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

返回一个（n x 2）数组，其中有n个名称及其出现在所选范围内

Excel-VBA：计算不同字符串的出现次数并列出它们

2 个答案: