在 VBA 中设置数据结构
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/41720284/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Set data structure in VBA
提问by Sandro
I'm looking for a setdata structure to use in Excel VBA. What I found so far is Scripting.Dictionary which seems to be a map.
我正在寻找要在 Excel VBA 中使用的集合数据结构。到目前为止我发现的是 Scripting.Dictionary ，它似乎是一张地图。
Is there also something like a set in VBA?
VBA中是否也有类似集合的东西？
Basically I'm looking for a data structure that is efficient for finding out if a particular value has already been added.
基本上，我正在寻找一种数据结构，它可以有效地找出是否已经添加了特定值。
回答by omegastripes
Take a look at .NET ArrayList, it has such methods as Add, Contains, Sortetc. You can instantiate the object within VBS and VBA environment:
看看.NET的ArrayList，它有这样的方法为Add，Contains，Sort等可以实例中VBS和VBA环境中的对象：
Set ArrayList = CreateObject("System.Collections.ArrayList")
Scripting.Dictionaryalso may fit the needs, it has unique keys, Existsmethod allows to check if a key is already in the dictionary.
Scripting.Dictionary也可能适合需要，它有唯一的键，Exists方法允许检查一个键是否已经在字典中。
However, SQL request via ADODB probably will be more efficient for that case. The below examples shows how to retrieve unique rows via SQL query to the worksheet:
但是，在这种情况下，通过 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
Source data should be placed on the Sheet1, the result is output to the Sheet2. The only limitation for that method is that ADODB connects to the Excel workbook on the drive, so any changes should be saved before query to get actual results.
源数据应该放在 上Sheet1，结果输出到 上Sheet2。该方法的唯一限制是 ADODB 连接到驱动器上的 Excel 工作簿，因此应在查询之前保存任何更改以获得实际结果。
If you want to get only the set of non-distinct rows, then the query should be as follows (just an example, you have to put your set of fields into query):
如果您只想获取一组非不同的行，则查询应如下所示（只是一个示例，您必须将您的一组字段放入查询中）：
strQuery = "SELECT CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country FROM [Sheet1$] GROUP BY CustomerID, CustomerName, ContactName, Address, City, PostalCode, Country HAVING Count(*) > 1"
回答by Blackhawk
Simply write a wrapper for Scripting.Dictionarythat exposes only set-like operations.
只需编写一个包装器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
And then you can use it like so:
然后你可以像这样使用它：
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
Which prints True, False and False as expected.
它按预期打印 True、False 和 False。
回答by Zerk
You could use a collection and do the following function, collections enforce unique key identifiers:
您可以使用集合并执行以下功能，集合强制执行唯一键标识符：
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
