LEFT JOIN na trzech zakresach   strona główna:
A po co ten Excel ;-)
 
Już jakiś czas dręczyło mnie żeby to przetestować ale jakoś nigdy nie było okazji aż pojawiło się zadanie:  
   >> Stan85 Mam 3 skoroszyty (jeden.xls, dwa.xls, trzy.xls). W kolumnach B każdego ze skoroszytu mam ID ludzi. Niestety nie   
                   wszystkie dane z kolumny B z jednego skoroszytu znajdują się w drugim. Chciałbym aby funkcja porównała zawartość   
                   kolumn B (ale niezależnie od wierszy czyli porównuje całą zawartość kolumn B z każdego skoroszytu) i wyświetla (..)   
                   tylko te ID które znajdują się w każdym ze skoroszytów.   
 
No więc stwórzmy sobie takie trzy skoroszyty, w których w Ark.Arkusz1 w kol.B znajdą się ID np.: ID10## (kolumna posiada nagłówek  
ID). Umieśćmy je w Folderze Test.  
 
   Na okazje korzystania z zapytań SQL z klauzulą SELECT mam w moim archiwum procedurkę która mi sprawę zasadniczo ułatwia.  
A wygląda ona następująco:  
 
Option Explicit  
 
Const adOpenStatic = 3  
Const adStateOpen = 1  
Const adEditNone = 0  
Const adUseClient = 3  
Const adCmdText = 1  
Const adModeRead = 1  
 
Private Sub ExecuteSQLCommand_ADO(strConnectionString As String, _  
                                  strSQL As String, _  
                                  rngKomCel As Excel.Range)  
    On Error GoTo ExecuteSQLCommand_ADO_Error  
    Dim objConnection As Object, objRecordset As Object  
     
    Set objConnection = CreateObject("ADODB.Connection")  
    With objConnection  
        .CursorLocation = adUseClient  
        .Mode = adModeRead  
        .Open strConnectionString  
        Set objRecordset = .Execute(strSQL, , adCmdText)  
        With objRecordset  
            If Not (.BOF And .EOF) Then rngKomCel.CopyFromRecordset objRecordset  
        End With  
    End With  
 
ExecuteSQLCommand_ADO_Exit:  
    On Error Resume Next  
    CloseRSObject objRecordset  
    CloseConObject objConnection  
    Exit Sub  
 
ExecuteSQLCommand_ADO_Error:  
    MsgBox "Byk nr: - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - ExeSQLComADO"  
    Resume ExecuteSQLCommand_ADO_Exit  
 
End Sub  
 
Public Sub CloseConObject(Cnn As Object)  
    If Not (Cnn Is Nothing) Then  
        If Cnn.State = adStateOpen Then Cnn.Close  
        Set Cnn = Nothing  
    End If  
End Sub  
 
Public Sub CloseRSObject(Rs As Object)  
    If Not (Rs Is Nothing) Then  
        With Rs  
            If CBool(.State And adStateOpen) Then  
                If .EditMode <> adEditNone Then .CancelUpdate  
                .Close  
            End If  
        End With  
        Set Rs = Nothing  
    End If  
End Sub  
 
Przyglądniemy się tylko argumentom i lecimy dalej.  
strConnectionString As String  
    nie powinien wymagać komentarza :-P a jeżeli... (link z prawej)   connectionstrings.com
strSQL As String  
    treść zapytania  
rngKomCel As Excel.Range  
    komórka docelowa od której (w dół i w prawo) zostają zwrócone dane.  
 
    No i zadanie  
Teoretycznie zapytanie powinno mieć następującą składnię  
SELECT A.[ID]  
FROM ([tabela1] AS A  
      LEFT JOIN [tabela2] AS B  
      ON A.[ID]=B.[ID])  
            LEFT JOIN [tablea3] AS C  
            ON A.[ID]=C.[ID];  
Dochodzą do tego jeszcze warunki złączenia ale do samej konstrukcji zapytanie nie są nam potrzebne.  
    Trudnością jest fakt że każdy z zakresów do porównania jest w innym pliku. Gdyby były to 3 zakresy w jednym pliku zapytanie byłoby  
dość proste: w powyższy schemat zamiast [tabela#] trzeba by wpisać odpowiednio [Arkusz#$B:B] (gdzie # to nr Arkusza np.: Arkusz2)  
Gdy jednak są to zakresy w oddzielnych plikach złączenie tworzy się łącząc tabele w różnych bazach danych trzeba zatem dokładniej  
określić pochodzenie danych. Np.: [Excel 8.0;HDR=Yes;IMEX=1;Database=" & strFilesPath & "dwa.xls;].[Arkusz1$B:B]  
    Znając więc składnię, zasady łączenia tabel w różnych bazach danych, wykorzystując procedurę ExecuteSQLCommand_ADO  
 
Sub TakieZapytanie()  
    Dim strConnString As String, strSQL As String  
    Dim strFilesPath As String  
     
    strFilesPath = ThisWorkbook.Path & "\test\"  
     
    strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _  
                    "Data Source=" & strFilesPath & "jeden.xls;" & _  
                    "Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""  
               
    strSQL = "SELECT A.[ID] " & _  
              "FROM ([Excel 8.0;HDR=Yes;IMEX=1;Database=" & strFilesPath & "jeden.xls;].[Arkusz1$B:B] AS A " & _  
              "LEFT JOIN [Excel 8.0;HDR=Yes;IMEX=1;Database=" & strFilesPath & "dwa.xls;].[Arkusz1$B:B] AS B " & _  
              "ON A.[ID]=B.[ID]) " & _  
              "LEFT JOIN [Excel 8.0;HDR=Yes;IMEX=1;Database=" & strFilesPath & "trzy.xls;].[Arkusz1$B:B] AS C " & _  
              "ON A.[ID]=C.[ID] WHERE Not B.[ID] IS Null AND Not C.[ID] IS Null;"  
 
    ExecuteSQLCommand_ADO strConnString, strSQL, [B2]  
 
End Sub   link do przykładu