备用一列

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

这可能是一个糟糕的答案，但是由于我不使用字典，因此这是我创建唯一值数组的方式-在此示例中，我将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，然后简单地将值写入（粘贴）到数组中，然后根据需要进行操作。

ADV版本

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版本

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

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

4 个答案:

备用一列

ADV版本

EDU版本