Установить структуру данных в VBA

Взгляните на .NET ArrayList, у него есть такие методы, как Add, Contains, Sort и т. д. Вы можете создать экземпляр объекта в среде VBS и VBA:

Set ArrayList = CreateObject("System.Collections.ArrayList")

Scripting.Dictionary тоже может подойти, у него уникальные ключи, метод Exists позволяет проверить, есть ли уже ключ в словаре.

Однако SQL-запрос через ADODB, вероятно, будет более эффективным в этом случае. В приведенных ниже примерах показано, как получить уникальные строки с помощью SQL-запроса к рабочему листу:

Option Explicit

Sub GetDistinctRecords()

    Dim strConnection As String
    Dim strQuery As String
    Dim objConnection As Object
    Dim objRecordSet As Object

    Select Case LCase(Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".")))
        Case ".xls"
            strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='" & ThisWorkbook.FullName & "';Mode=Read;Extended Properties=""Excel 8.0;HDR=YES;"";"
        Case ".xlsm", ".xlsb"
            strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source='" & ThisWorkbook.FullName & "';Mode=Read;Extended Properties=""Excel 12.0 Macro;HDR=YES;"";"
    End Select

    strQuery = "SELECT DISTINCT * FROM [Sheet1$]"
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Open strConnection
    Set objRecordSet = objConnection.Execute(strQuery)
    RecordSetToWorksheet Sheets(2), objRecordSet
    objConnection.Close

End Sub

Sub RecordSetToWorksheet(objSheet As Worksheet, objRecordSet As Object)

    Dim i As Long

    With objSheet
        .Cells.Delete
        For i = 1 To objRecordSet.Fields.Count
            .Cells(1, i).Value = objRecordSet.Fields(i - 1).Name
        Next
        .Cells(2, 1).CopyFromRecordset objRecordSet
        .Cells.Columns.AutoFit
    End With

End Sub

Исходные данные помещаются на Sheet1, результат выводится на Sheet2. Единственное ограничение для этого метода заключается в том, что ADODB подключается к книге Excel на диске, поэтому любые изменения должны быть сохранены перед запросом, чтобы получить фактические результаты.

Если вы хотите получить только набор неразличимых строк, то запрос должен быть следующим (просто пример, вы должны поместить свой набор полей в запрос):

    strQuery = "SELECT CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country FROM [Sheet1$] GROUP BY CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country HAVING Count(*) > 1"

Вы можете использовать коллекцию и выполнить следующую функцию: коллекции применяют уникальные идентификаторы ключей:

Public Function InCollection(Col As Collection, key As String) As Boolean
  Dim var As Variant
  Dim errNumber As Long

  InCollection = False
  Set var = Nothing

  Err.clear
  On Error Resume Next
    var = Col.Item(key)
    errNumber = CLng(Err.Number)
  On Error GoTo 0

  '5 is not in, 0 and 438 represent incollection
  If errNumber = 5 Then ' it is 5 if not in collection
    InCollection = False
  Else
    InCollection = True
  End If

End Function

Просто напишите оболочку для Scripting.Dictionary, которая предоставляет только операции, подобные наборам.

клссет

Option Explicit

Private d As Scripting.Dictionary

Private Sub Class_Initialize()
    Set d = New Scripting.Dictionary
End Sub

Public Sub Add(var As Variant)
    d.Add var, 0
End Sub

Public Function Exists(var As Variant) As Boolean
    Exists = d.Exists(var)
End Function

Public Sub Remove(var As Variant)
    d.Remove var
End Sub

И тогда вы можете использовать его так:

mdlMain

Public Sub Main()
    Dim s As clsSet
    Set s = New clsSet

    Dim obj As Object

    s.Add "A"
    s.Add 3
    s.Add #1/19/2017#

    Debug.Print s.Exists("A")
    Debug.Print s.Exists("B")
    s.Remove #1/19/2017#
    Debug.Print s.Exists(#1/19/2017#)
End Sub

Который печатает True, False и False, как и ожидалось.