數據量不多的話沒必要通過字典過橋，直接借用壹個空的工作表作為過橋即可，我是通過SHEET3
代碼如下
Sub 父子關系1()
On Error Resume Next
Sheets("Sheet3").Cells.Select
Selection.ListObject.QueryTable.Delete
Sheets("Sheet3").Select
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=C:\Documents and Settings\xd\桌面\工作簿1.xlsm;DefaultDir=C:\Documents and Settings\xd\桌面;DriverId=1046;MaxBuffe" _
), Array("rSize=2048;PageTimeout=5;")), Destination:=Range("$A$1")).QueryTable
.CommandText = Array( _
"SELECT AA.A, AA.B, BB.A, BB.B" & Chr(13) & "" & Chr(10) & "FROM AA AA, BB BB" & Chr(13) & "" & Chr(10) & "WHERE AA.B = BB.A")
.PreserveFormatting = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "表_查詢來自_Excel_Files"
End With
Sheets("Sheet1").Select
For J = 1 To Sheet1.[b65536].End(xlUp).Row
For I = 1 To Sheet3.[b65536].End(xlUp).Row
If Sheet1.Cells(J, 4) <> "" And Sheet1.Cells(J, 4) = Sheet3.Cells(I, 4) And Sheet1.Cells(J, 2) <> Sheet3.Cells(I, 2) Then
TEMP = TEMP & Sheet3.Cells(I, 1)
End If
Next
Sheet1.Cells(J, 5) = TEMP
TEMP = ""
Next
End Sub