程序代码：

Public Sub GetCUSTOMERList()
Dim CUSTID() As String, CUSTOMER() As String
Dim i As Integer
   
    Set rs = New ADODB.Recordset
    rs.Open "SELECT *" + " FROM [" & SheetName & "$] Where " + Title(4), cn, adOpenStatic 'CUSTID
     For i = 0 To rs.RecordCount - 1
        ReDim Preserve CUSTID(i)
        CUSTID(i) = rs.Fields.Item(Title(4))
        rs.MoveNext
     Next i
    
     Set rs = Nothing
    
     Set rs = New ADODB.Recordset
    rs.Open "SELECT *" + " FROM [" & SheetName & "$] Where " + Title(5), cn, adOpenStatic 'CUSTOMER
     For i = 0 To rs.RecordCount - 1
        ReDim Preserve CUSTOMER(i)
        CUSTOMER(i) = rs.Fields.Item(Title(5))
        rs.MoveNext
     Next i
    
     Set rs = Nothing
    
     Call CustList(CUSTID(), CUSTOMER())
    
End Sub

Private Sub CustList(Temp1() As String, Temp2() As String)
Dim i As Integer, j As Integer, k As Integer
Dim Check As Boolean, ListCount As Integer
Dim CustTemp() As String, Code As String
   
    ListCount = 0: ReDim CUSTOMERList(ListCount): Check = False
   
    For i = 0 To UBound(Temp1)
        If CUSTOMERList(0) = "" Then
            CUSTOMERList(ListCount) = Temp1(i) & "&" & Temp2(i)
            ListCount = ListCount + 1
        Else
            Check = False
            For j = 0 To UBound(CUSTOMERList)
                Code = Temp1(i) & "&" & Temp2(i)
                If Mid$(Code, 1, InStr(Code, "&") - 1) = Mid$(CUSTOMERList(j), 1, InStr(CUSTOMERList(j), "&") - 1) Then
                    If InStr(Mid$(CUSTOMERList(j), InStr(Code, "&") + 1), "&") <> 0 Then
                        CustTemp = Split(Mid$(CUSTOMERList(j), InStr(CUSTOMERList(j), "&") + 1), "&")
                        For k = 0 To UBound(CustTemp)
                            If Mid$(Code, InStr(Code, "&") + 1) = CustTemp(k) Then
                                Check = True
                                Exit For
                            End If
                        Next k
                        If Check = False Then
                            CUSTOMERList(j) = CUSTOMERList(j) & "&" & Temp2(i)
                            Check = True
                        End If
                        Erase CustTemp
                    Else
                        If Mid$(Code, InStr(Code, "&") + 1) = Mid$(CUSTOMERList(j), InStr(CUSTOMERList(j), "&") + 1) Then
                            Check = True
                        Else
                            Check = True
                            CUSTOMERList(j) = CUSTOMERList(j) & "&" & Temp2(i)
                        End If
                    End If
                End If
                If Check = True Then
                    Exit For
                End If
            Next j
            If Check = False Then
                ReDim Preserve CUSTOMERList(ListCount)
                CUSTOMERList(ListCount) = Temp1(i) & "&" & Temp2(i)
                ListCount = ListCount + 1
            End If
        End If
    Next i
   
    Call WriteCUSTOMER

End Sub