Excel VBA – 收集错误

我正在尝试构build一个集合，并从该集合中获取唯一值的计数，但是在构build集合本身时出现错误。 任何人都可以build议我哪里错了。 请分享您的想法。 请让我知道如何找出唯一值的计数。

Sub trial() Dim sampleVisualBasicColl As Collection For i = 2 To 10 Rng = Range("M" & i).value StartsWith = Left(Rng, 3) If StartsWith = "Joh" Then sampleVisualBasicColl.Add Rng Else End If Next Debug.Print (sampleVisualBasicCol1) End Sub 

Answer 1

使用集合，您可以将Joh添加到集合中，然后对这些项目进行计数：

 'Using a collection Sub Col_test() Dim cCol As Collection Dim i As Long Set cCol = New Collection On Error GoTo Err_Handler With ThisWorkbook.Worksheets("Sheet1") For i = 2 To 20 If Left(.Cells(i, 13), 3) = "Joh" Then cCol.Add .Cells(i, 13).Value, .Cells(i, 13).Value End If Next i End With Debug.Print cCol.Count On Error GoTo 0 Exit Sub Err_Handler: Select Case Err.Number Case 457 'This key is already associated with an element of this collection Err.Clear Resume Next Case Else MsgBox "Error " & Err.Number & vbCr & _ " (" & Err.Description & ") in procedure Col_test." Err.Clear End Select End Sub 

如果你想要每个项目的数量（约翰，本…你有什么），然后用一个字典：

 'Using a dictionary. Sub Dic_Test() Dim dict As Object Dim i As Long Dim sValue As String Dim key As Variant Set dict = CreateObject("Scripting.Dictionary") With ThisWorkbook.Worksheets("Sheet1") For i = 2 To 20 If Len(.Cells(i, 13)) >= 3 Then sValue = Left(.Cells(i, 13), 3) If dict.exists(sValue) Then dict(sValue) = dict(sValue) + 1 Else dict(sValue) = 1 End If End If Next i End With For Each key In dict.keys Debug.Print key & " = " & dict(key) Next key End Sub 

注意：我在代码中使用Cells而不是Range 。 Cells(2,13)是M2（第13列，第2行）。

我发现这个链接非常有助于字典： https ： //excelmacromastery.com/vba-dictionary/

作为进一步更新（ 接受答案后 ），并使用你在这里给你的问题列表： Excel VBA – 公式计数唯一值错误此代码与字典将返回Joh = 4, Ian = 3

 'Using a dictionary. Sub Dic_Test() Dim dict As Object Dim dictFinal As Object Dim i As Long Dim sValue As String Dim key As Variant Dim keyFinal As String Set dict = CreateObject("Scripting.Dictionary") Set dictFinal = CreateObject("Scripting.Dictionary") 'Get the unique values from the worksheet. With ThisWorkbook.Worksheets("Sheet1") For i = 2 To 20 If Len(.Cells(i, 13)) >= 3 Then sValue = .Cells(i, 13).Value If dict.exists(sValue) Then dict(sValue) = dict(sValue) + 1 Else dict(sValue) = 1 End If End If Next i End With 'Count the unique values in dict. For Each key In dict.keys keyFinal = Left(key, 3) If dictFinal.exists(keyFinal) Then dictFinal(keyFinal) = dictFinal(keyFinal) + 1 Else dictFinal(keyFinal) = 1 End If Next key For Each key In dictFinal.keys Debug.Print key & " = " & dictFinal(key) Next key End Sub 

Answer 2

您需要创build集合并声明它。

 Sub trial() Dim myCol As Collection Set myCol= New Collection ' creates the collection For i = 2 To 10 Rng = Range("M" & i).value StartsWith = Left(Rng, 3) If StartsWith = "Joh" Then myCol.Add Rng Else End If Next For each x in myCol Debug.Print x Next x End Sub 

Answer 3

嘿这个代码将帮助你，因为它收集列表框中的唯一值，

Private Sub UserForm_Initialize（）Dim cUnique As Collection Dim Rng As Range Dim Cell As Range Dim sh As Worksheet Dim vNum As Variant

Set sh = ThisWorkbook.Sheets（“Sheet1”）Set Rng = sh.Range（“A2”，sh.Range（“A2”）。Value =“John”。End（xlDown））

设置cUnique =新集合

在错误恢复下一步

对于Rng.Cells中的每个单元格cUnique.Add Cell.Value，CStr（Cell.Value）Next Cell

在错误转到0

对于每个vNum在cUnique Me.ListBox1.AddItem vNum

下一个vNum结束小组

Answer 4

你还没有宣布variablesRng和我这些是最重要的事情要做。 同时我想提出这个公式,,

如果（Len（B2：B20）>匹配（B2：B20）= 0，则匹配（B2：B20，B2：B20， B2：B20,0），“”，））> 0,1））

它的Array公式就这样用Ctrl + Shift + Enter结束。

你也可以用这个，

Sub CountUnique（）Dim i，count，j As Integer count = 1 For i = 1 To 470 flag = False如果count

1然后对于j = 1要计数If Sheet1.Cells（i，3）.Value = Sheet1.Cells（j，11）.Value Then flag = True End If Next j Else flag = False End If If flag = False Then Sheet1 .Cells（count，11）.Value = Sheet1.Cells（i，3）.Value count = count + 1 End IfNext I Sheet1.Cells（1，15）.Value = count End Sub