excel 在VBA中设置数据结构

jecbmhm3  于 2023-01-18  发布在  其他
关注(0)|答案(4)|浏览(167)

我正在寻找一个set数据结构在Excel VBA中使用。我发现到目前为止是Scripting.Dictionary,这似乎是一个map
VBA中是否也有类似集合的东西?
基本上,我正在寻找一种数据结构,它可以有效地发现是否已经添加了特定的值。

bqf10yzr

bqf10yzr1#

看一下.NET ArrayList,它有AddContainsSort等方法,可以在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"
uurity8g

uurity8g2#

您可以使用集合并执行以下函数,集合强制使用唯一键标识符:

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
du7egjpx

du7egjpx3#

只需为Scripting.Dictionary编写一个 Package 器,只公开类似于集合的操作。

类集

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

然后你可以这样使用它:

mdl主视图

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。

neekobn8

neekobn84#

如果在添加Collection时随Item一起提供Key,则Collection将被编入索引。请注意,虽然项可以是任何类型的对象,但键必须是字符串。

Private Sub testset()
    ' set up an array to hold source values
    Dim values()
    values = Array("Item1", "Item2", "Item1")
    ' declare a collection
    Dim col As New Collection
    ' loop through the array and add items with the key string
    For Each item In values
        On Error Resume Next
        ' ignore the error raised if the key is already present
        col.Add item:=item, Key:=item
        On Error GoTo 0
    Next
    
    ' loop through the set
    For Each item In col
        Debug.Print item
    Next
End Sub

输出:

Item1
Item2

相关问题