Создать пустые списки, а затем добавить элементы в этот список

Question

У меня есть код на Python, который я пытаюсь преобразовать в VBA.

List = [] 

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

Я бы создал пустой список, код Python будет циклически проходить по моим желаемым данным (определяемым здесь как «диапазон»), затем проверял, был ли элемент в списке, и если его не было,добавь это.

Я пытаюсь сделать то же самое в 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 

Когда я запускаю этот код, я получаюошибка, в которой выделен «список» в

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

и написано

«Неверный квалификатор».

Я попытался изменить его на

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

чтобы добавить классификатор.

Все, что мне нужно сделать, это создать список строк.Есть ли лучший способ сделать это в VBA?

Answer 1

Вы можете использовать словарь для обработки уникальных предметов.В этом случае массив будет эквивалентен списку.Вы заполняете отдельный список из словарных ключей.

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

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

Spare a Column

Если у вас есть данные в столбце A, и вы можете сэкономить столбец, например, столбец B, самый быстрый способ получить в нем уникальные значения - использовать AdvancedFilter, а затем просто написать (вставьте) значения в массив и сделайте, как вам угодно.

ADV Version

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

EDU Version

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

Это, вероятно, ужасный ответ, но, поскольку я не использую словари, вот как я создаю массив уникальных значений - в этом примере я добавляю все уникальные значения в столбце 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