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

【问题标题】：Excel-VBA: Count occurrencies of a different strings and list themExcel-VBA：计算不同字符串的出现次数并列出它们
【发布时间】：2014-09-13 05:06:23
【问题描述】：

今天我遇到以下问题：我在 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

这太疯狂了，我知道有一个更简单的解决方案......我只是找不到它。

【问题讨论】：

这里可能值得一读：spreadsheetpage.com/index.php/file/…
Gareth 很好，但是我如何访问数据透视表的结果（例如，我需要将不同的单词和出现的情况存储在数组中）？考虑到我对数据透视表一无所知，我可以创建一个而不在我的工作表中“写下来”吗？
您需要编程解决方案 (VBA) 还是更喜欢一些手动数据表操作？
请编程。如前所述，我无法修改我的数据表/插入公式等。

标签： vba excel excel-formula pivot-table find-occurrences

【解决方案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 错误处理程序以增加与字典中现有水果键配对的值，并从那里恢复正常执行

希望有助于澄清

【讨论】：

这对我来说有点黑暗，想解释一下这个东西是如何工作的？
当然我会在回复部分解释一下作为编辑，评论太乱了
Set dic = Nothing 是否可能是 sourcemem？另外，我可以将 k 声明为字符串（如果我理解正确的话）吗？
我已经清理了一点——一开始的工作表选择也有问题。现在应该没事了，抱歉。将 k 重新声明为字符串，这是一个很好的问题——不过我认为你不能这样做。据我所知，变量类型实际上并不等同于字符串，即使它在某些情况下看起来像一个字符串。

【解决方案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 个名称及其在所选范围内的出现

【讨论】：