循环创build对象excel vba
我尝试获取“RD”范围内每列的唯一值，并将其显示在单列中。 我需要创build一个对象（“scripting.Dictionary”），其中只有Range“RD”中的列数。 我试过这个代码，但它导致“运行时错误13”。
Private Sub CommandButton1_Click() Range(Me.RefEdit1).Name = "RD" Range(Me.RefEdit2).Name = "OT" Dim d As Object, c As Variant, i As Long, s As Long Dim JK As Long Dim o As Collection JK = Range("RD").Columns.Count Set d = CreateObject("Scripting.Dictionary") For k = 0 To JK + 1 d.Item(k) = CreateObject("Scripting.Dictionary").Item(k) c = Range("RD").Columns(k + 1) If d.Exists(k) Then d.Item(k) = d.Item(k) + 1 'increment Else d.Item(k) = 1 'set as 1st occurence End If For i = 1 To UBound(c, 1) d.Item(k)(c(i, 1)) = 1 Next i Range("OT").Cells((k * 5) + 2, 2).Resize(d.Item(k).Count) = Application.Transpose(d.Item(k).Keys) Range("OT").Cells((k * 5) + 2, 2).Resize(d.Item(k).Count).Sort Key1:=Range("OT").Cells((k * 5) + 2, 2).Resize(d.Item(k).Count) Next k End Sub 我在下面添加一些代码来帮助遍历一个列表，寻找唯一的值，并将它们添加到一个新的列。 在我的例子中，我将整个function放在一个loop以提高效率。 我还将这些唯一值添加到Sheet2的新单元格，从单元格A1开始。
让我知道你是否需要任何额外的帮助。
基于误解的编辑代码：
Private Sub CommandButton1_Click() Dim oDict As Object Dim rngToScrub As Range Dim rngNewColumnToStoreUnique As Range Dim oCol As Range Dim cel As Range Set rngToScrub = Range(Me.RefEdit1.Value) Set rngNewColumnToStoreUnique = Sheet2.Range("A1") For Each oCol In rngToScrub.Columns Set oDict = CreateObject("Scripting.Dictionary") For Each cel In oCol.Cells If oDict.exists(cel.Value) Then 'Do Nothing for Now Else oDict.Add cel.Value, 0 rngNewColumnToStoreUnique.Value = cel.Value Set rngNewColumnToStoreUnique = rngNewColumnToStoreUnique.Offset(1) End If Next cel Set oDict = Nothing Next oCol End Sub
旧代码：误解了要求
Private Sub CommandButton1_Click() Dim oDict As Object Dim rngToScrub As Range Dim rngNewColumnToStoreUnique As Range Dim cel As Range Set oDict = CreateObject("Scripting.Dictionary") Set rngToScrub = Range(Me.RefEdit1.Value) Set rngNewColumnToStoreUnique = Sheet2.Range("A1") For Each cel In rngToScrub If oDict.exists(cel.Value) Then 'Do Nothing for Now Else oDict.Add cel.Value, 0 rngNewColumnToStoreUnique.Value = cel.Value Set rngNewColumnToStoreUnique = rngNewColumnToStoreUnique.Offset(1) End If Next cel End Sub