Question

我遇到了特定流程的问题。在H列中，有许多不同的数字。我正在寻找一个循环，对于列中每个新发现的值，计算该列中出现的值的次数，并将计数值放在下一个工作表“Statistik”中。

我确实有一个解决方案，我为列中的每个单独的数字创建了一个代码，但我正在寻找一个循环，因为该列中有28个不同的值。

Image of my workbook

有没有人能为我的问题找到明智的解决方案？

提前致谢。

Answer 1

您需要使用COUNTIF。作为公式或您的VBA代码（Application.CountIf()）。

在您的情况=COUNTIF(H:H, [UNIQUE_VALUE])中，唯一值是您要提取的值。要获得唯一值，您有两种选择。一种方法是将H：H中的唯一值复制到Statistik表中，如下所示：

点击数据功能区菜单
在Sort＆amp;中选择高级按钮。过滤部分
填写对话框，复制到其他位置，列出范围 H：H ，复制到 Statistik工作表中的某些列*确保勾选* *仅限唯一记录

此处详细介绍了获取唯一值的其他选项https://exceljet.net/formula/extract-unique-items-from-a-list

有关COUNTIF的更多信息 https://support.office.com/en-us/article/countif-function-e0de10c6-f885-4e71-abb4-1f464816df34

Answer 2

您可以使用字典仅输出1个键和值

Option Explicit

Public Sub GetCount()
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet1")                    'change as appropriate
        Dim arr(), i As Long
        arr = Intersect(.Columns("H"), .UsedRange) '<=== Specify exact range in H to loop over if you want including header
        For i = LBound(arr, 1) + 1 To UBound(arr, 1) 'assuming header to ignore otherwise start at 1
            If Not dict.exists(arr(i, 1)) Then
                dict.Add arr(i, 1), 1  '<==== if value not seen before add to dictionary with value of 1
            Else
                dict(arr(i, 1)) = dict(arr(i, 1)) + 1 ' <====== if seen before add 1 to the existing count
            End If
        Next i
    End With

    With Worksheets("Statistik")
        .Range("A1") = "StudyBoard_ID"
        .Range("B1") = "Count"
        .Range("A2").Resize(dict.Count, 1) = Application.Transpose(dict.Keys)
        .Range("B2").Resize(dict.Count, 1) = Application.Transpose(dict.Items)
    End With
End Sub

为范围中的每个新值创建新的单元格值

2 个答案: