Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.1k views
in Technique[技术] by (71.8m points)

excel - syncing two lists with VBA

What is the best way to sync up two lists each of which may contain items not in the other? As shown the lists are not sorted - although if necessary sorting them first would not be an issue.

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

Using the lists above, I'm looking for a solution that will write out to a spreadsheet in two columns:

a
b  b
c  c
   d
e  e
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Here are some notes on using a disconnected recordset.

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...