0

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

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

4

2 回答 2

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

希望有助于澄清

于 2014-07-22T12:50:53.037 回答
0

检查您的答案是否正确并 +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 个名称及其在所选范围内的出现

于 2014-07-22T14:26:11.700 回答