VBA와 두 목록 동기화

Question

두 목록을 동기화하는 가장 좋은 방법은 각각 다른 목록에없는 항목을 포함 할 수 있습니다. 표시된대로 목록은 정렬되지 않습니다. 필요한 경우 먼저 정렬하면 문제가되지 않지만 위의 목록을 사용하여

List 1 = a,b,c,e 
List 2 = b,e,c,d 

, 나는 두 개의 열에서 스프레드 시트에 기록합니다 솔루션을 찾고 있어요 :

a 
b b 
c c 
    d 
e e 

Answer 1

을 여기에 연결이 끊긴 된 레코드를 사용하는 방법에 대한 몇 가지주의 사항.

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 

Answer 2

가 여기에 또 다른 옵션들, 사전을 사용하여 현재 (다른 여러 상당히 유용한 개체가 마이크로 소프트 런타임 스크립팅에 대한 참조를 추가! -없이 VBA 코딩을 시작하지 않는) 서면으로

, 결과물은 분류되지 않습니다. 그것은 약간의 진부한 표현 일 수 있습니다. 어쨌든, 여기에 몇 가지 멋진 트릭이 있습니다.

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 

Answer 3

또 다른 옵션은 컬렉션입니다. 이렇게하면 알파벳순으로 출력이 정렬되지 않지만 필요한 경우 먼저 목록을 정렬 할 수 있습니다. 이 또한 중복 목록을 제거하고 고유 한 목록을 제공합니다. 이 코드는 목록이 문자열 배열 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