从Excel将唯一值填充到VBA数组中

Question

谁能给我VBA代码，该代码将从Excel工作表获取一个范围（行或列），并用唯一值填充列表/数组，即：

table

table

chair

table

stool

stool

stool

chair

当宏运行时会创建一个数组，例如：

fur[0]=table

fur[1]=chair

fur[2]=stool

Answer 1

在这种情况下，我总是使用这样的代码（只要确保您选择的分度数不在搜索范围内即可）Dim tmp As StringDim arr() As StringIf Not Selection Is Nothing Then&nbsp; &nbsp;For Each cell In Selection&nbsp; &nbsp; &nbsp; If (cell <> "") And (InStr(tmp, cell) = 0) Then&nbsp; &nbsp; &nbsp; &nbsp; tmp = tmp & cell & "|"&nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp;Next cellEnd IfIf Len(tmp) > 0 Then tmp = Left(tmp, Len(tmp) - 1)arr = Split(tmp, "|")

Answer 2

Sub GetUniqueAndCount()&nbsp; &nbsp; Dim d As Object, c As Range, k, tmp As String&nbsp; &nbsp; Set d = CreateObject("scripting.dictionary")&nbsp; &nbsp; For Each c In Selection&nbsp; &nbsp; &nbsp; &nbsp; tmp = Trim(c.Value)&nbsp; &nbsp; &nbsp; &nbsp; If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1&nbsp; &nbsp; Next c&nbsp; &nbsp; For Each k In d.keys&nbsp; &nbsp; &nbsp; &nbsp; Debug.Print k, d(k)&nbsp; &nbsp; Next kEnd Sub

Answer 3

将Tim的Dictionary方法与下面Jean-Francois的变量数组结合在一起。您想要的阵列位于 objDict.keysSub A_Unique_B()Dim XDim objDict As ObjectDim lngRow As LongSet objDict = CreateObject("Scripting.Dictionary")X = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp)))For lngRow = 1 To UBound(X, 1)&nbsp; &nbsp; objDict(X(lngRow)) = 1NextRange("B1:B" & objDict.Count) = Application.Transpose(objDict.keys)End Sub