Zakres danych do Tabeli Przestawnej większy niż 65536 wierszy   strona główna:
A po co ten Excel ;-)
 
   >> MartaK Mam problem z makrem tworzącym tabelę przestawną , kiedy liczba wierszy przekracza 65536. Makro działa ok kiedy    
                   mam mniej wierszy, a jak dodam coś ponad, to się "wywala". <<  
 
    Choć nie siedzę ostatnio zbyt często na E2007 to jednak temat ciekawy, a rozwiązanie godne wyjaśnienia. Tym bardziej że jakoś  
na każdym kroku odpowiedź się nie pałęta. Sam trafiłem fartem, trochu rozwinąłem temat, poprawiłem trochu procedurę i Wam  
drodzy czytelnicy do wglądu podeślę. ;-)  
 
    Rozwiązanie wyczytałem na pcreview.co.uk/forums   Pivot Table Type Mismatch when More than 65536 rows 
    >> Arthur Jenkins  For some reason the syntax Range("A1").CurrentRegion will not work if there are more than 65,536 rows.   
                               You need to use R1C1 notation in place of this syntax to tell Excel the location of the data  
 
I choć właśnie ta podpowiedź rozwiązuje problem to zaproponowany sposób średnio mi się podoba więc napisałem swoją procedurkę.  
 
Option Explicit  
 
Sub przestawna()  
    Dim wksDane As Excel.Worksheet, rngDane As Excel.Range  
    Dim wksPivot As Excel.Worksheet, rngCel As Excel.Range  
    Dim pvtC As Excel.PivotCache, pvtT As Excel.PivotTable  
      
    '-------------------------kompliacja warunkowa---------------------------  
    '   appVersion = True -> Excel 2003  ; appVersion = False > Excel 2007  
    #Const appVersion = True  
    '------------------------------------------------------------------------  
      
    Const strNewWksName As String = "TabelaPrzestawna"  
      
    Set wksDane = ThisWorkbook.Worksheets("Dane")  
    Set rngDane = wksDane.Range("A1").CurrentRegion  
      
    On Error Resume Next  
    Set wksPivot = ThisWorkbook.Worksheets(strNewWksName)  
    On Error GoTo 0  
    If Not wksPivot Is Nothing Then  
        Application.DisplayAlerts = False  
        wksPivot.Delete  
        Application.DisplayAlerts = True  
    End If  
      
    Set wksPivot = ThisWorkbook.Worksheets.Add  
    With wksPivot  
        .Name = strNewWksName  
        Set rngCel = .Range("A3")  
    End With  
      
    #If appVersion Then  
        '----------------------------- Excel 2003 -------------------------------  
        Set pvtC = ThisWorkbook.PivotCaches.Add( _  
                SourceType:=xlDatabase, _  
                SourceData:=rngDane.Address(ReferenceStyle:=xlR1C1, External:=True))  
                  
        Set pvtT = pvtC.CreatePivotTable(TableDestination:=rngCel)  
        '------------------------------------------------------------------------  
    #Else  
        '----------------------------- Excel 2007 -------------------------------  
        Set pvtC = ThisWorkbook.PivotCaches.Create( _  
                SourceType:=xlDatabase, _  
                SourceData:=rngDane.Address(ReferenceStyle:=xlR1C1, External:=True), _  
                Version:=xlPivotTableVersion12)  
          
        Set pvtT = pvtC.CreatePivotTable(TableDestination:=rngCel)  
        '------------------------------------------------------------------------  
    #End If  
    With pvtT  
        With .PivotFields("spolka")  
            .Orientation = xlColumnField  
            .Position = 1  
        End With  
        With .PivotFields("kod")  
            .Orientation = xlRowField  
            .Position = 1  
        End With  
        .AddDataField .PivotFields("sprzedaz"), _  
                      "Suma z Sprzedaż", _  
                      xlSum  
        .RowGrand = False  
    End With  
      
    Set wksPivot = Nothing  
    Set pvtC = Nothing  
    Set pvtT = Nothing  
End Sub  
 
To co fragmentami.. :-P  
 
    Const strNewWksName As String = "TabelaPrzestawna"  
      
    On Error Resume Next  
    Set wksPivot = ThisWorkbook.Worksheets(strNewWksName)  
    On Error GoTo 0  
    If Not wksPivot Is Nothing Then  
        Application.DisplayAlerts = False  
        wksPivot.Delete  
        Application.DisplayAlerts = True  
    End If  
      
    Set wksPivot = ThisWorkbook.Worksheets.Add  
    With wksPivot  
        .Name = strNewWksName  
        Set rngCel = .Range("A3")  
    End With  
 
Chcę żeby tabela utworzyła się w ark.TabelaPrzestawna jednak taki arkusz może już istnieć. Wyłączając reakcję procedury na błędy  
próbuję utworzyć zmienną obiektową wksPivot i przywracam procedurę do normalnej obsługi błędów.  
Jeżeli do zmiennej zostanie przypisany istniejący arkusz należy go usunąć (wyłączając na ten czas alerty aplikacji). Następnie   
tworzymy arkusz ponownie określając rngCel jako kom.A3 w tym Arkuszu.  
 
    '-------------------------kompliacja warunkowa---------------------------  
    '   appVersion = True -> Excel 2003  ; appVersion = False > Excel 2007  
    #Const appVersion = True  
    '------------------------------------------------------------------------  
      
    #If appVersion Then  
        '----------------------------- Excel 2003 -------------------------------  
        '------------------------------------------------------------------------  
    #Else  
        '----------------------------- Excel 2007 -------------------------------  
        '------------------------------------------------------------------------  
    #End If  
 
Wprowadzam kompilację warunkową (zasady -> link z prawej).   Conditional Compilation
(Visual Basic) 
Gdyby chodziło jedynie o stałą xlPivotTableVersion12 dostępną dopiero w E2007 to by się ją po prostu uwzględniło w procedurze  
    Const xlPivotTableVersion12 = 3  
ale tabele przestawne zmieniły się dużo bardziej w E2007. w E2003 nie ma metody PivotCaches.Create i tego by nam kompilator nie   
odpuścił :-) Więc jak używamy E2007, a przecież problem dotyczy właśnie tej wersji (z E2010 nie miałem jeszcze przyjemności) to   
appVersion ustawić na False. Jednak jeżeli chcemy napisać temat, testując poprawność procedury w E2003, to trzeba tak sobie  
komplikować. ;-)  
 
        Set pvtC = ThisWorkbook.PivotCaches.Create( _  
                SourceType:=xlDatabase, _  
                SourceData:=rngDane.Address(ReferenceStyle:=xlR1C1, External:=True), _  
                Version:=xlPivotTableVersion12)  
          
        Set pvtT = pvtC.CreatePivotTable(TableDestination:=rngCel)  
 
    With pvtT  
        With .PivotFields("spolka")  
            .Orientation = xlColumnField  
            .Position = 1  
        End With  
        With .PivotFields("kod")  
            .Orientation = xlRowField  
            .Position = 1  
        End With  
        .AddDataField .PivotFields("sprzedaz"), _  
                      "Suma z Sprzedaż", _  
                      xlSum  
        .RowGrand = False  
    End With  
 
To już samo serce procedury pod E2007 i właśnie zmiana dotycząca wskazania zakresu danych.  
nie rngDane - obiekt/zakres, a adres zakresu w notacji R1C1 - string! A to ma swoje następstwa.  
   Zapis:  
         rngDane.Address(ReferenceStyle:=xlR1C1, External:=True)  
oznacza adres w notacji R1C1 jednak, choć nie wymagalne, to wg mnie istotne jest wskazanie zakresu "dokładnie", a więc Dane!A1:??  
zamiast do Adresu doklejać rngDane.Parent.Name można właśnie posłużyć się arg. Metody Address tj External równe True  
 
Ps: zastanawia mnie pewna kwestia.  
    Jeżeli tworzenie ciągle nowej Tabeli Przestawnej jest podyktowane ciągłym przybywaniem danych źródłowych to może lepszym    Tworzenie dynamicznego zakresu nazwanego w arkuszu
rozwiązaniem byłoby zdefiniować dynamiczny zakres nazwany i podać go jako źródło danych w kreatorze tworzenia Tabeli Przestawnej  
Następnie po prostu odświeżać tabelę.  
  Excel Pivot Table
Dynamic Data Source
 
Hej :D