与VBA同步两个列表
什么是最好的方式来同步两个列表，每个列表可能包含不在其他项目？ 如图所示，这些列表没有sorting – 尽pipe如果有必要，先sorting它们不会是一个问题。
List 1 = a,b,c,e List 2 = b,e,c,d 使用上面的列表，我正在寻找一个解决scheme，将写出到电子表格两列：
a bb cc d ee
以下是关于使用断开的logging集的一些注意事项。
Const adVarChar = 200 'the SQL datatype is varchar 'Create arrays fron the lists asL1 = Split("a,b,c,", ",") asL2 = Split("b,e,c,d", ",") 'Create a disconnected recordset Set rs = CreateObject("ADODB.RECORDSET") rs.Fields.append "Srt", adVarChar, 25 rs.Fields.append "L1", adVarChar, 25 rs.Fields.append "L2", adVarChar, 25 rs.CursorType = adOpenStatic rs.Open 'Add list 1 to the recordset For i = 0 To UBound(asL1) rs.AddNew Array("Srt", "L1"), Array(asL1(i), asL1(i)) rs.Update Next 'Add list 2 For i = 0 To UBound(asL2) rs.MoveFirst rs.Find "L1='" & asL2(i) & "'" If rs.EOF Then rs.AddNew Array("Srt", "L2"), Array(asL2(i), asL2(i)) Else rs.Fields("L2") = asL2(i) End If rs.Update Next rs.Sort = "Srt" 'Add the data to the active sheet Set wks = Application.ActiveWorkbook.ActiveSheet rs.MoveFirst intRow = 1 Do For intField = 1 To rs.Fields.Count - 1 wks.Cells(intRow, intField + 1) = rs.Fields(intField).Value Next intField rs.MoveNext intRow = intRow + 1 Loop Until rs.EOF = True
这里有另外一个select，这次使用Dictionaries（添加一个对Microsoft Scripting Runtime的引用，它还有其他几个非常有用的对象 – 没有它就不会启动VBA编码！）
正如所写，输出不sorting – 这可能是一个showstopper位。 无论如何，这里有几个很好的小窍门：
Option Explicit Public Sub OutputLists() Dim list1, list2 Dim dict1 As Dictionary, dict2 As Dictionary Dim ky Dim cel As Range Set dict1 = DictionaryFromArray(Array("a", "b", "c", "e")) Set dict2 = DictionaryFromArray(Array("b", "e", "c", "d")) Set cel = ActiveSheet.Range("A1") For Each ky In dict1.Keys PutRow cel, ky, True, dict2.Exists(ky) If dict2.Exists(ky) Then dict2.Remove ky End If Set cel = cel.Offset(1, 0) Next For Each ky In dict2 PutRow cel, ky, False, True Set cel = cel.Offset(1, 0) Next End Sub Private Sub PutRow(cel As Range, val As Variant, in1 As Boolean, in2 As Boolean) Dim arr(1 To 2) If in1 Then arr(1) = val If in2 Then arr(2) = val cel.Resize(1, 2) = arr End Sub Private Function DictionaryFromArray(arr) As Dictionary Dim val Set DictionaryFromArray = New Dictionary For Each val In arr DictionaryFromArray.Add val, Nothing Next End Function
另一个选项是集合。 这不会按字母顺序对输出进行sorting，但如果需要，可以先对列表进行sorting。 注意这也将给你一个独特的清单，剥离重复。 代码假定你的列表在string数组L1和L2中。
Dim C As New Collection,i As Long, j As Long ReDim LL(UBound(L1) + UBound(L2), 2) As String 'output array For i = 1 To UBound(L1) On Error Resume Next 'try adding to collection C.Add C.Count + 1, L1(i) 'store sequence number,ie 1,2,3,4,... On Error GoTo 0 j = C(L1(i)) 'look up sequence number LL(j, 1) = L1(i) Next i For i = 1 To UBound(L2) 'same for L2 On Error Resume Next C.Add C.Count + 1, L2(i) On Error GoTo 0 j = C(L2(i)) LL(j, 2) = L2(i) Next i 'Result is in LL, number of rows is C.Count Range("Results").Resize(UBound(LL, 1), 2) = LL