在VBA中设置数据结构
我正在寻找在Excel VBA中使用的设置数据结构。 我发现迄今为止，Scripting.Dictionary似乎是一个地图 。
在VBA中是否也有类似的东西？
基本上我正在寻找一个数据结构，是有效的，以找出是否已经添加一个特定的值。
看一看.NET ArrayList ，它有Add ， Contains ， Sort等方法。你可以在VBS和VBA环境中实例化对象：
Set ArrayList = CreateObject("System.Collections.ArrayList")
Scripting.Dictionary也可以满足需求，它有唯一的键， Exists方法允许检查一个键是否已经在字典中。
但是，对于这种情况，通过ADODB的SQL请求可能会更有效。 以下示例显示如何通过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"
您可以使用集合并执行以下function，集合将强制使用唯一的密钥标识符：
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编写一个封装器，只公开类似于集合的操作。
clsSet
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
如预期那样打印真，假和假。