0

我有很大范围的值，中间有一些空格，我想知道如何找到所有不同值的总和，每个值在该范围内都有自己的总和。

例如，我有（在 A1:D5 范围内）： 

| Low | Low | --- | Low |  
| Low | High| --- | Low |  
| --- | --- | --- | --- |  
| Pie | --- | Low | High|  
| --- | --- | Low | --- |

我希望程序吐出：（
在范围或 msgbox 或任何东西中，用户需要写下数字） 

High: 2  
Low: 7 
Pie: 1

我尝试过的：
我尝试使用该CountIF功能，但在正确解决它时遇到了问题。
我有超过 800 行要测试，所以我想避免在一个简单的 for 循环中遍历每一行。

加分点：（
我很高兴能回答上面的问题，但如果有人也能弄清楚这一点，那将不胜感激）
有些单元格值由一个单词的多个实例甚至多个单词组成。
例如，一些单元格包含

Low
Low

仅由回车分隔。本月甚至有一个单元格包含

Low
Low
High
Low
Low

我还想计算单元格内的每次出现，所以上面的单元格会给出输出：

High: 1
Low: 4
4

2 回答 2

3

试试这个：

Sub tgr()

    Dim cllUnq As Collection
    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim arrUnq(1 To 65000) As String
    Dim arrCount(1 To 65000) As Long
    Dim varWord As Variant
    Dim MatchIndex As Long
    Dim lUnqCount As Long

    On Error Resume Next
    Set rngCheck = Application.InputBox("Select the cells containing strings to be counted", "Select Range", Selection.Address, Type:=8)
    On Error GoTo 0
    If rngCheck Is Nothing Then Exit Sub    'Pressed cancel

    Set cllUnq = New Collection

    For Each CheckCell In rngCheck.Cells
        For Each varWord In Split(CheckCell.Text, Chr(10))
            If Len(Trim(varWord)) > 0 Then
                On Error Resume Next
                cllUnq.Add varWord, varWord
                On Error GoTo 0
                If cllUnq.Count > lUnqCount Then
                    lUnqCount = cllUnq.Count
                    arrUnq(lUnqCount) = CStr(varWord)
                    arrCount(lUnqCount) = 1
                Else
                    MatchIndex = WorksheetFunction.Match(CStr(varWord), arrUnq, 0)
                    arrCount(MatchIndex) = arrCount(MatchIndex) + 1
                End If
            End If
        Next varWord
    Next CheckCell

    If lUnqCount > 0 Then
        Sheets.Add After:=Sheets(Sheets.Count)
        With Range("A1:B1")
            .Value = Array("Word", "Count")
            .Font.Bold = True
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
        End With
        Range("A2").Resize(lUnqCount).Value = Application.Transpose(arrUnq)
        Range("B2").Resize(lUnqCount).Value = Application.Transpose(arrCount)
    End If

    Set cllUnq = Nothing
    Set rngCheck = Nothing
    Set CheckCell = Nothing
    Erase arrUnq
    Erase arrCount

End Sub
于 2013-08-23T15:02:42.483 回答
1

试试 .find 方法。转到您的 VBA 帮助，查找 range.find 方法以获取更多信息 - 它还提供了一些您应该能够轻松修改的代码。
我建议为每次找到时更新的每个值使用一个计数器。例如：

Dim Low_count As Long  
Low_count = 0  
With Worksheets(1).Range("a1:a500")  
 Set c = .Find("Low", LookIn:=xlValues)  
 If Not c Is Nothing Then  
  firstAddress = c.Address
  Do
   Low_count = Low_count + 1
   Set c = .FindNext(c)
  Loop While Not c Is Nothing And c.Address <> firstAddress
 End If
End With
于 2013-08-23T15:01:41.437 回答