在VBA中动态创建集合/数组

时间:2017-06-08 13:54:57

标签: vba object ms-access

我正在努力解决这个问题,我正在使用VBA在Access中做一些事情,我需要动态创建N个集合/列表/记录数组并将它们添加到我的字典中。

//Some pseudo code
Dim dict as object
Set dict = CreateObject("Scripting.Dictionary")

for record in myRecordSetObject
    if dict.exists(keyfromrecord)
         dict(keyfromrecord) = array.add(record)
    else
         newarray = [record]
         dict.add key:="keyfromrecord" item:=array

如果无法完成,我可能只需要执行一串主键并根据需要增长,然后调用字符串拆分。

修改

所以我有我的记录,我需要根据他们可能分享或不分享的几个常见字段将它们分成子组。如果两个记录在这些选择字段中具有相同的信息,则它们位于子组中。子组可能有1-N个记录。

我没有获得所有可能的组合并过滤我的查询,而是想创建一个字典,将其键定义为从这些字段生成的字符串。如果一个密钥存在,则该子组的成员,如果它不是一个新的子组。

该值将是一系列记录。

之后我会查看我的字典并用这些记录做些事情。

Field1     Field2     Field3    Field4
Fruit      Skinned    Sliced    Baked
Apples     True       True      True
Bananas    True       True      True
Oranges    True       False     False

使用上面的这个例子,当Field2,3和4具有相同的值时。 (苹果,香蕉)和另一个(橘子)

我想要一个Key为

的字典
dictionary{
           "True-True-True": [Apples, Bananas],
           "True-False-True": [Oranges]
}

2 个答案:

答案 0 :(得分:1)

不确定这是否是你所追求的,但是这会在每个字典键中放入每个组合的记录集。

根据您的表格,它会提供

的键

FALSE-FALSE-FALSE-,FALSE-FALSE-TRUE-,FALSE-TRUE-FALSE-,FALSE-TRUE-TRUE-,TRUE-FALSE-FALSE-,TRUE-FALSE-TRUE-,TRUE-TRUE-FALSE-,TRUE-TRUE-TRUE-

其中? dicOutput("TRUE-TRUE-TRUE-").recordcount返回2条记录  和GroupTable("0fruits")("TRUE-TRUE-TRUE-").recordcount相同的2

希望这有帮助

Function GroupTable(strTableName As String) As Scripting.Dictionary

Dim strKey As String
Dim diccols As New Scripting.Dictionary
Dim dicOutput As Scripting.Dictionary
Dim dicTruth As Scripting.Dictionary
Dim rst As ADODB.Recordset
Dim rcols As ADODB.Recordset

Set rcols = New ADODB.Recordset
Set rcols = CurrentProject.Connection.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTableName, Empty))

While Not rcols.EOF

    If rcols.Fields("COLUMN_NAME").Value <> "Fruit" Then
        diccols.Add CStr(diccols.Count), rcols.Fields("COLUMN_NAME").Value
    End If

    rcols.MoveNext
Wend

Set dicTruth = maketruthtable(2 ^ diccols.Count - 1, diccols.Count)
Set dicOutput = New Scripting.Dictionary

For l = 0 To dicTruth.Count - 1
    strSQL = "select [fruit] from [" & strTableName & "] where " & Join(diccols.Items(), "&") & "='" & dicTruth.Items()(l) & "'"
    Set rst = New ADODB.Recordset
    rst.Open strSQL, CurrentProject.Connection, adOpenStatic
    dicOutput.Add Replace(Replace(dicTruth.Items()(l), "-1", "TRUE-"), "0", "FALSE-"), rst
Next l

Set GroupTable = dicOutput

End Function

Function maketruthtable(intMax As Integer, intOptions As Integer) As Scripting.Dictionary

Dim d As New Scripting.Dictionary
Dim j As Integer

For j = 0 To intMax
    d.Add CStr(j), Replace(Right(DecToBin(j), intOptions), "1", "-1")
Next j

Set maketruthtable = d

End Function

Public Function DecToBin(ByVal lngDec As Long) As String

 Const MAXLEN = 5
 Dim strBin As String
 Dim n As Long

 If lngDec < 0 Then
    strBin = "1"
 Else
    strBin = "0"
 End If

 For n = MAXLEN To 0 Step -1
 If lngDec And (2 ^ n) Then
    strBin = strBin & "1"
 Else
    strBin = strBin & "0"
 End If
 Next

 DecToBin = strBin

 End Function

修改

另一个解决方案是使用SQL来完成它,所以如果你有一个表在1行中只有TRUE而在另一行中只有False,例如名为tblLogicOptions,就像这样

enter image description here

然后,您可以在名为0Fruits

的表上使用以下SQL

enter image description here

使用以下SQL

select LOGICTABLE.*,Data.Fruit FROM (select ((x1.a) & (x2.a) & (x3.a)) as Logic from tblLogicOptions  as x1, tblLogicOptions  as x2, tblLogicOptions  as x3) AS LOGICTABLE
LEFT JOIN
(SELECT F1.Fruit, [skinned] & [sliced] & [baked] AS LogicCompare
FROM 0fruits as F1) AS DATA ON LOGICTABLE.Logic=DATA.LogicCompare

给出了结果

enter image description here

通过这种方式来构建字典,或者甚至使用结果记录集,我认为会更容易。

答案 1 :(得分:0)

您可以使用Redim关键字更改数组大小