VBA查询循环scripting.dictionary

我有这个：

Set dict = CreateObject("Scripting.Dictionary") rn = 2 Do While ThisWorkbook.Sheets("1").Range("B" & rn).Value <> "" If (ThisWorkbook.Sheets("1").Range("B" & rn).Value <> "") Then dict("&&1") = dict & ThisWorkbook.Sheets("1").Range("B" & rn).Value & ", " rn = rn + 1 Loop 

但是这不起作用，我得到了VBA中的错误450。

它需要做的是：B列中的每个值（如果不是空的）必须被添加到由逗号分隔的字典中。 在最后一行之后，可能不会设置逗号。

我认为我是正确的，但也有缺失的东西。

Answer 1

要获得所有的唯一值到一个string，你可以修改你的代码如下

请注意，您应该使用ThisWorkbook.Sheets(1)不ThisWorkbook.Sheets("1")

请使用MsgBox Left$(strOut, Len(strOut) - 2)来修复尾随的非必需部分

 Sub a() Dim ws As Worksheet Set dict = CreateObject("Scripting.Dictionary") Dim strOut As String Set ws = Sheets(1) rn = 2 Do While ws.Range("B" & rn).Value <> "" If Len(ws.Range("B" & rn).Value) > 0 Then If dict.exists(ws.Range("B" & rn).Value) Then Else dict.Add ws.Range("B" & rn).Value, 1 strOut = strOut & (ws.Range("B" & rn).Value & ", ") End If End If rn = rn + 1 Loop MsgBox strOut End Sub 

Answer 2

只是为了抛出更加简洁的brettdj解决scheme

 Sub main() Dim cell As Range Dim strOut As String With CreateObject("Scripting.Dictionary") For Each cell In Sheets(1).Range("B2", Sheets(1).Cells(.Rows.Count, "B")).SpecialCells(xlCellTypeConstants, xlTextValues) .Item(cell.Value) = 1 Next strOut = Join(.keys, ",") MsgBox strOut End With End Sub