创建空列表，然后将元素附加到该列表

Question

我在 Python 中有代码，我正试图将其转换为 VBA。

List = [] 

For x in range:
    if x not in list:
    list.append(x)

我会创建一个空列表，Python 代码会遍历我想要的数据（这里定义为 "range"），然后检查该元素是否在列表中，如果不在'吨，添加它。

我正在尝试在 VBA 中做同样的事情。它需要向下一列，并将该列中的唯一元素添加到 VBA 列表。

根据搜索我有这个：

Dim list() As Variant

For n = 1 To end
   If list.Contains(Cells(n,1).value) Then 
       list(n) = Cells(n,1).value 
       n= n+1

当我运行这段代码时，我得到一个错误，它突出显示了

中的 "list"

If list.Contains(Cells(n,1).value) Then

并说

"Invalid qualifier".

我尝试将其更改为

if list.Contains(Cells(n,1).value) = True

添加限定词。

我需要做的就是创建一个字符串列表。在 VBA 中有更好的方法吗？

Answer 1

这可能是一个糟糕的答案，但由于我不使用字典，下面是我创建唯一值数组的方法 - 在本例中，我将 A 列中的所有唯一值添加到一个数组 (然后在最后打印它们）

Option Explicit
Sub Test()

Dim list() As Variant
Dim inlist As Boolean
Dim n As Long, i As Long, j As Long, endrow As Long

endrow = Cells(Rows.Count, 1).End(xlUp).Row

ReDim list(0 To 0)
inlist = False
j = 0

For n = 1 To endrow
    For i = 0 To UBound(list)
        If list(i) = Cells(n, 1).Value Then
            inlist = True
        End If
    Next i

    If inlist = False Then
        list(j) = Cells(n, 1).Value
        j = j + 1
        ReDim Preserve list(0 To j)
    End If

    inlist = False
Next n

For i = 0 To UBound(list) - 1
    Debug.Print list(i)
Next i

End Sub

Answer 2

由于您需要一个 String 对象数组，您可以先用唯一值构建一个字符串，然后将其拆分为一个数组：

For n = 1 To nEnd
    If InStr(1, strngs, "%" & Cells(n, 1).Value & "%") = 0 Then strngs = strngs & "%" & Cells(n, 1).Value & "%" & "|"
Next
If strngs <> vbNullString Then list = Split(Replace(Left(strngs, Len(strngs) - 1), "%", ""), "|")

Answer 3

备用一列

如果你有A列的数据，你可以空出一列，例如B 列，获取其中唯一值的最快方法应该是使用 AdvancedFilter，然后只需将值写入（粘贴）到数组中，然后随意使用即可。

高级版

Sub UniqueAF1()

  Const cVntSrcCol As Variant = "A"      ' Source List Column Letter/Number
  Const cVntUniCol As Variant = "B"      ' Unique List Column Letter/Number
  Const cIntHeaderRow As Integer = 1     ' Header Row Number

  Dim vntUni As Variant                  ' Unique Array
  Dim i As Long                          ' Unique Array Row Counter

  With ThisWorkbook.ActiveSheet

    ' Write unique values to Unique Column using AdvancedFilter.
    .Cells(cIntHeaderRow, cVntSrcCol).Resize(.Cells(.Rows.Count, cVntSrcCol) _
        .End(xlUp).Row - cIntHeaderRow + 1) _
        .AdvancedFilter 2, , .Cells(cIntHeaderRow, cVntUniCol), 2

    ' Write unique values to Unique Array
    vntUni = .Cells(cIntHeaderRow + 1, cVntUniCol) _
        .Resize(.Cells(.Rows.Count, cVntUniCol) _
        .End(xlUp).Row - cIntHeaderRow + 1)

    ' Print contents of Unique Array to Immediate window.
    For i = 1 To UBound(vntUni)
      Debug.Print vntUni(i, 1)
    Next

  End With

End Sub

教育版

Sub UniqueAF2()

  Const cVntSrcCol As Variant = "A"      ' Source List Column Letter/Number
  Const cVntUniCol As Variant = "B"      ' Unique List Column Letter/Number
  Const cIntHeaderRow As Integer = 1     ' Header Row Number

  Dim rngSrc As Range                    ' Source Range
  Dim rngUni As Range                    ' Unique Range

  Dim vntUni As Variant                  ' Unique Array

  Dim lngLastRow As Long                 ' Source Last Row
  Dim i As Long                          ' Unique Array Row Counter

  With ThisWorkbook.ActiveSheet

    Set rngSrc = .Cells(cIntHeaderRow, cVntSrcCol)  ' Source Range
    Set rngUni = .Cells(cIntHeaderRow, cVntUniCol)  ' Unique Range
    lngLastRow = .Cells(.Rows.Count, cVntSrcCol) _
        .End(xlUp).Row - cIntHeaderRow + 1          ' Calculate last row.
    Set rngSrc = rngSrc.Resize(lngLastRow)          ' Determine Source Range.

    ' Apply AdvancedFilter.
    rngSrc.AdvancedFilter 2, , .Cells(cIntHeaderRow, cVntUniCol), 2

    lngLastRow = .Cells(.Rows.Count, cVntUniCol) _
        .End(xlUp).Row - cIntHeaderRow + 1          ' Calculate last row.

    vntUni = rngUni.Resize(lngLastRow)              ' Paste range into array.

    ' Print contents of Unique Array to Immediate window.
    For i = 1 To UBound(vntUni)
      Debug.Print vntUni(i, 1)
    Next

  End With

End Sub

Answer 4

您可以使用字典来处理唯一项目。在这种情况下，数组将等同于列表。您从字典键填充不同的列表。

Public Sub test()
    Dim r As Range   ' this is what you would iterate over bit like your existing range
    Dim distinctList() 'empty list
    Dim dict As Object, inputValues(), i As Long
    Set r = ActiveSheet.Range("A1:A10")          'Alter as required
    Set dict = CreateObject("Scripting.Dictionary")
    inputValues = Application.Transpose(r.Value) 'List of all values. Faster to process as array.
    For i = LBound(inputValues) To UBound(inputValues)
        dict(inputValues(i)) = vbNullString 'add distinct list values to dictionary with overwrite syntax
    Next
    If dict.Count > 0 Then
        distinctList = dict.keys ' generate distinct list
    End If
End Sub

创建空列表，然后将元素附加到该列表

Create empty lists and then append elements to that list

excel

vba

advanced-filter

备用一列

高级版

教育版