Excel VBA 计算和打印不同的值答案

【问题标题】：Excel VBA to count and print distinct valuesExcel VBA 计算和打印不同的值
【发布时间】：2012-03-28 14:58:48
【问题描述】：

我必须计算一列中不同值的数量，并用不同的值打印它并在另一张纸上计数。我正在使用这段代码，但由于某种原因，它没有返回任何结果。谁能告诉我我在哪里错过了这件作品！

Dim rngData As Range
Dim rngCell As Range
Dim colWords As Collection
Dim vntWord As Variant
Dim Sh As Worksheet
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet

On Error Resume Next

Set Sh1 = Worksheets("A")
Set Sh2 = Worksheets("B")
Set Sh3 = Worksheets("C")

Sh1.Range("A2:B650000").Delete

Set Sh = Worksheets("A")
Set r = Sh.AutoFilter.Range
r.AutoFilter Field:=24
r.AutoFilter Field:=24, Criteria1:="My Criteria"

Sh1.Range("A2:B650000").Delete

Set colWords = New Collection

Dim lRow1 As Long
lRow1 = <some number>

Set rngData = <desired range>
For Each rngCell In rngData.Cells
    colWords.Add colWords.Count + 1, rngCell.Value
    With Sh1.Cells(1 + colWords(rngCell.Value), 1)
        .Value = rngCell.Value
        .Offset(0, 1) = .Offset(0, 1) + 1
    End With
Next

以上是我的完整代码。我需要的结果很简单，计算一列中每个单元格的出现次数，然后将其打印在另一张表中并显示出现次数。谢谢！

谢谢！导航。

【问题讨论】：

请发布您的完整代码。
你的代码有点奇怪。正如 brettdj 所说，发布您的完整代码并向我们解释您对代码的期望
嗨 Brettdj 和 JMax- 请查看完整代码...
代码还有很多问题；未声明的变量，未使用的其他变量。它看起来很像大块的提取物。
>>>“它没有返回任何结果。谁能告诉我我错过了哪里！”：当你删除 On Error Resume Next

标签： vba excel

【解决方案1】：

使用字典对象来做这件事非常简单实用。逻辑类似于 Kittoes 的回答，但字典对象更快、更高效，并且您可以在此处输出所有键和项的数组。我已将代码简化为从 A 列生成列表，但您会明白的。

Sub UniqueReport()

Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim varray As Variant, element As Variant

varray = Range("A1:A10").Value

'Generate unique list and count
For Each element In varray
    If dict.exists(element) Then
        dict.Item(element) = dict.Item(element) + 1
    Else
        dict.Add element, 1
    End If
Next

'Paste report somewhere
Sheet2.Range("A1").Resize(dict.Count, 1).Value = _
    WorksheetFunction.Transpose(dict.keys)
Sheet2.Range("B1").Resize(dict.Count, 1).Value = _
    WorksheetFunction.Transpose(dict.items)

End Sub

它是如何工作的：您只需将范围转储到一个变体数组中以快速循环，然后将每个数组添加到字典中。如果它存在，您只需获取与他们的键一起使用的项目（从 1 开始）并添加一个。然后最后只需在您需要的地方拍打唯一列表和计数。请注意，我为字典创建对象的方式允许任何人使用它 - 无需添加对代码的引用。

【讨论】：

@user1087661：我同意 Issun 的观点，即字典 obect 将是更好的选择。我只选择了 Array 路线，因为我认为您可能会更喜欢它。
太棒了。我不是专业的程序员，但我使用过 Python 并且了解字典。但是，我不知道它们存在于 VBA 中！
请注意脚本字典对象仅适用于 Windows 用户 - 不幸的是，您不能在 Mac 上使用它... :(
如何选择整列？
改成 varray = Range("A:A").Value

【解决方案2】：

不是最漂亮或最理想的路线，但它会完成工作，我很确定你能理解它：

Option Explicit

Sub TestCount()

Dim rngCell As Range
Dim arrWords() As String, arrCounts() As Integer
Dim bExists As Boolean
Dim i As Integer, j As Integer

ReDim arrWords(0)

For Each rngCell In ThisWorkbook.Sheets("Sheet1").Range("A1:A20")
    bExists = False

    If rngCell <> "" Then
        For i = 0 To UBound(arrWords)
            If arrWords(i) = rngCell.Value Then
                bExists = True
                arrCounts(i) = arrCounts(i) + 1
            End If
        Next i

        If bExists = False Then
            ReDim Preserve arrWords(j)
            ReDim Preserve arrCounts(j)

            arrWords(j) = rngCell.Value
            arrCounts(j) = 1

            j = j + 1
        End If
    End If
Next

For i = LBound(arrWords) To UBound(arrWords)
    Debug.Print arrWords(i) & ", " & arrCounts(i)
Next i

End Sub

这将遍历“Sheet1”上的 A1:A20。如果单元格不为空，它将检查该单词是否存在于数组中。如果不存在，则将其添加到计数为 1 的数组中。如果确实存在，则将其简单地添加到计数中。我希望这能满足您的需求。

此外，在浏览您的代码后要记住的一点是：您几乎不应该使用On Error Resume Next。

【讨论】：