首页 文章

计算范围中每个唯一字符串的出现次数

提问于
浏览
0

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

例如,我有(在A1:D5范围内):

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

我想要该程序吐出:
(在某个范围或msgbox或任何内容中,用户需要记下这些数字)

High: 2  
Low: 7 
Pie: 1

What I've tried:
我尝试使用 CountIF 函数,但是在正确计算它时遇到了问题 .
我有超过800行测试,所以我想避免在一个简单的for循环中遍历每一行 .

Bonus points:
(我会对上面的答案感到满意,但如果有人能够解决这个问题,我将非常感激)
有些单元格值由一个单词甚至多个单词的多个实例组成 .
例如,一些单元格包含

Low
Low

仅由回车分开 . 本月有一个单元格包含

Low
Low
High
Low
Low

我还想计算单元格内的每个出现次数,因此上面的单元格将给出输出:

High: 1
Low: 4

2 回答

  • 1

    尝试一下:

    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
    
  • 2

    试试.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
    

相关问题