Question

我有很多值，中间有一些空白，我想知道如何找到所有不同值的总和，每个值都有自己的总值。

例如，我有（在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

Answer 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

Answer 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

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

2 个答案: