Rozszerzenie możliwości Tabeli Przestawnej poprzez Microsoft Query lub budowanie Pivota na Recordset'cie ADO   strona główna:
A po co ten Excel ;-)
 
 
 
     Mamy taki zestaw danych. (Wartości danych są zwrócone złączeniami tesktów i formuł i nie są istotne) Naszym zadaniem jest stworzenie na tych  
danych tabeli przestawnej która w polu Wierszy miałaby nazwiska, w polu Kolumn: WZ i F, w Polu Wartości Sumę dla F i WZ w oddzielnych kolumnach  
 
  A B C  
1 nazwisko dokument wart  
2 nazwisko1 WZ 0001/12 62,67  
3 nazwisko2 F 0001/12 58,06  
4 nazwisko3 WZ 0003/12 84,62  
5 nazwisko4 F 0003/12 81,87  
6 nazwisko5 WZ 0005/12 31,34  
7 nazwisko6 F 0005/12 40,13  
8 nazwisko7 WZ 0007/12 15,71  
9 nazwisko8 F 0007/12 26,11  
10 nazwisko9 WZ 0009/12 73,44  
11 nazwisko1 F 0009/12 39,68  
12 nazwisko2 WZ 0011/12 84,25  
13 nazwisko3 F 0011/12 99,07  
14 nazwisko4 WZ 0013/12 27,22  
15 nazwisko5 F 0013/12 12,23  
16 nazwisko6 WZ 0015/12 43,07  
17 nazwisko7 F 0015/12 7,17  
18 nazwisko8 WZ 0017/12 13,15  
19 nazwisko9 F 0017/12 10,44  
20 nazwisko1 WZ 0019/12 86,42  
21 nazwisko2 F 0019/12 58,34  
22 nazwisko3 WZ 0021/12 27,78  
23 nazwisko4 F 0021/12 87,98  
 
Prosty sposób utworzenia tabeli przestawnej (TP) utworzy dla każdego unikalnego elementu kol.dokument (z definicji każdy element tej kolumny będzie  
unikatowy) oddzielną kolumnę w polu Kolumn tabeli przestawnej. A nam chodzi o wyciągnięciu sumy dla Faktur i WZ dla każdego nazwiska.  
Na mój stan wiedzy (a o Pivotach jakiś duży on nie jest) nie utworzę Pola Obliczeniowego żeby dodać Pole które wyciągnie z pola dokument znaki  
przed spacją. Jednak w zapytaniu SQL dodanie takiego pola jest zupełnie proste. Jak zatem połączyć TP z możliwościami SQL?  
Znam dwa osoby:  
 - Wskazanie danych do utworzenia TP poprzez Microsoft Query, dopisanie dodatkowego pola w definicji SQL Kwerendy.  
 - Utworzenie TP z Recordsetu (ADO)  
 
Najpierw zatem sposób poprzez M$ Query. (opis dla E2007/10)
 
 
1. Karta: Dane / Dane zewnętrzne / Z innych źródeł / Z programu Microsoft Query   
2. Wybierz źródło danych: / Excel Files -> OK   
3. Wybierz skoroszyt: wskazać plik z danymi -> OK (u mnie Zeszyt1.xlsx na pulpicie)  
 
3a. Możliwe że pjawi się nam komunikat:
 
 
oznacza to że w Opcjach Tabeli nie mamy zaznaczonej…  
 
 
 
 
 
 
 
 
4. W Kreatorze Kwerend / okno: Dostepne tabele i kolumny / Rozwinąc: Arkusz1$ (Arkusz w ktróym znajdują się dane)  
5. Przyciskiem [>] do okna "Kolumny w kwerendzie" przeciągnąć pola: nazwisko, dokument, wart / Dalej / Dalej/ ...   
 
 
 
 
 
6. W ostatnim kroku (nie klikasz 'Zakończ') Na pytanie 'Co chcesz zrobić dalej?' Zaznaczamy Opcję: Wyświetlić dane lub edytować kwerendę   
    w programie Microsoft Query / nastepnie klimasz "Zakończ'   
 
7. Otworzy się okno Programu "M$" Query. Klikamy przycisk [SQL]. W oknie SQL pokaże się treść zapytania. To zapytanie należy rozszerzyć o dodatkowe  
    pole: nazwijmy go Left2. Do tego pola Funkcjami SQL wyciągniemy fragment elementów pola dokument.  
 
`Arkusz1$`.dokument - to nazwa pola (` to znak pod tyldą). Left(pole,InStr(pole,' ')-1) zwroci F lub WZ tj ciąg z elementów pola dokument od lewej  
do spacji.  
     Cały ciąg kwerendy to:  
SELECT `Arkusz1$`.nazwisko, `Arkusz1$`.dokument, `Arkusz1$`.wart, Left(`Arkusz1$`.dokument,InStr(`Arkusz1$`.dokument,' ')-1) AS 'Left2'
FROM `C:\Users\MiTKuchta\Desktop\Zeszyt1.xlsx`.`Arkusz1$` `Arkusz1$`
 
 
 
pogrubiony fragment został dodany.  
 
8. Zamykamy program i pokazuje się okno dialogowe "Importowanie danych". Wybieramy sposób wyświetlania danych: Raport w formie tabeli przestawnej,  
    wskazujemy miejsce gdzie ma się utworzyć tabela i klikamy OK. 
 
 
9. Listę pól należy ustawić w sposób przedstawiony poniżej co kończy zadanie.  
 
    Taki sposób umożliwia odświeżanie takiej tabeli. Cała procedura zatem jest jednorazowa i po zmienia danych w pliku z źródłowym można zaktualizować  
dane w TP jednym kliknięciem.  
 
  Drugą metodą jest utworzenie TP z Recordsetu. (Tu już mniej obrazków a więcje kodu ;-) )  
 
Option Explicit  
Public Const adUseClient = 3  
Public Const adModeRead = 1  
Public Const adCmdText = 1  
Public Const adStateOpen = 1  
Public Const adEditNone = 0  
 
 
Sub PivotNaADORecordset()  
    On Error GoTo PivotNaADORecordset_Error  
 
    Dim wks As Excel.Worksheet  
    Dim objPivotCache As PivotCache, objPivTable As PivotTable  
    Dim strPlikZDanymiFullName As String  
      
    Dim objConnection As Object  
    Dim objRecordset As Object  
 
    Const strSQL As String = "SELECT [nazwisko], " & _  
                                    "[dokument], " & _  
                                    "[wart], " & _  
                                    "Left([dokument],InStr([dokument],"" "")-1) As Left2 " & _  
                              "FROM [Arkusz1$]"  
                            
    Const strPivName As String = "pivMojaTabela"  
    Const strXLSFile As String = "C:\Users\MiTKuchta\Desktop\Zeszyt1.xlsx"  
      
      
    Set objConnection = CreateObject("ADODB.Connection")  
    With objConnection  
      
        .CursorLocation = adUseClient  
        .Mode = adModeRead   Funkcja XLSConnectionString
        .Open XLSConnectionString(strXLSFile)  
          
        Set objRecordset = .Execute(strSQL, , adCmdText)  
          
    End With  
      
    If Not (objRecordset.BOF And objRecordset.EOF) Then  
          
        Set wks = ThisWorkbook.Worksheets("Arkusz1")  
        Set objPivotCache = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)  
        Set objPivotCache.Recordset = objRecordset  
        objPivotCache.CreatePivotTable TableDestination:=wks.Range("A1"), _  
                                       TableName:=strPivName  
 
          
        wks.Range("A1").Select  
    End If  
      
    ThisWorkbook.ShowPivotTableFieldList = True  
 
PivotNaADORecordset_Exit:  
    On Error Resume Next  
      
    Application.ScreenUpdating = True  
      
    Set wks = Nothing  
    Set objPivotCache = Nothing  
    Set objPivTable = Nothing  
      
    CloseRSObject objRecordset  
    CloseConObject objConnection  
    Exit Sub  
 
PivotNaADORecordset_Error:  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - PivNaADORec"  
    Resume PivotNaADORecordset_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  
 
Procedura raczej prosta. Jej efektem jest utworzenie TP bez rozmieszczenia pól opisanego w poprzedniej metodzie.  
Minusem tej metody jest niemożliwość odświeżania danych w takiej TP procedura zatem musi pozostać pod ręką. :-)