VBA查询循环scripting.dictionary

Question

我有这个：

 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列中的每个值(如果它不是空的)必须添加到由逗号分隔的dict中。当然，在最后一行之后，它可能不会设置逗号。

我想我是在正确的道路上，但有遗漏的东西。

Answer 1

要获得字符串的所有唯一值，可以修改代码，如下所示

请注意，您应该使用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解决方案。

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