Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

VBA Excel - wykres przestawny dla zmiennych danych źródłowych

Sir_Ryan 16 Lis 2015 13:47 771 1
  • #1 16 Lis 2015 13:47
    Sir_Ryan
    Poziom 10  

    Witam,

    Mam problem - otóż próbuję stworzyć makro które wykonuje mi tabelę i wykres przestawny dla zmiennych danych źródłowych które znajdują się w innym arkuszu. W innym arkuszu mają być generowane wykresy przestawne - jeden po drugim. Jeden wykres przestawny mi się generuje ale teraz poszukuję kodu który automatycznie wynajdzie mi powiedzmy 5 wolną komórkę pod kolumną "A".

    Mógłby mi ktoś w tym pomóc ? Jeśli macie jakieś uwagi do samego kody również proszę o rady :)
    Kod to zlepek moich bardzo słabych umiejętności, kodów zdobytych w internecie i przechwyconych z książki - także proszę o wyrozumiałość.


    Code:
    Option Explicit
    
    Sub zakresDanych()

    'deklaracja zmiennych
    Dim FinalRow As Long
    Dim FinalCol As Long
    Dim i As Long
    Dim PRange As Range
    Dim WSD As Worksheet
    Dim WSD2 As Worksheet
    Dim PTCache As PivotCache
    Dim pt As PivotTable
    Set WSD = Worksheets("nowaTabela")
    Set WSD2 = Worksheets("DaneZrodlowe")


    'usuwanie tabeli przestawnej
    For Each pt In WSD.PivotTables
        pt.TableRange2.Clear
    Next pt

    'usuwanie wykresu
    For i = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(1).Delete
    Next

    'Okreslanie zakresu danych
    FinalRow = WSD2.Cells(Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD2.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = WSD2.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)

    'Tworzenie tabeli przestawnej
    Set pt = PTCache.CreatePivotTable(TableDestination:=WSD.Cells(4, 1), TableName:="Dane")

    'tworzenie wykresu przestawnego z innego modułu
    Call sbPivotChartInNewSheet

    'aktualizacja danych w tabeli
    'pt.ManualUpdate = True

    'Określanie nagłówków w kolumnach i wierszach
    pt.AddFields RowFields:=Array("Stoppage Class")

    'okreslenie wartosci wyswietlanych w tabeli
    With pt.PivotFields("% Occ. Time")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With

    With pt.PivotFields("CCLI")
        .Orientation = xlPageField
        .Position = 1
    End With

    With pt.PivotFields("Bottleneck Machine(s)")
        .Orientation = xlPageField
        .Position = 1
    End With

    With pt.PivotFields("Start Time")
        .Orientation = xlPageField
        .Position = 1
    End With

    'Obliczenie tabeli
    pt.ManualUpdate = True

    Range("A5").Select
    'Range("A1").End(xlDown).Offset(1).Select

        End Sub
       

    Sub sbPivotChartInNewSheet()

    'deklarowanie zmiennych
    Dim pt As PivotTable, ptr As Range, cht As Chart

       
    'If no pivots exit procedure - jesli nie ma tabeli przestawnej, procedura wyjscia
        If ActiveSheet.PivotTables.Count = 0 Then Exit Sub
       
    'setting piovot table - ustawienia tabeli przestawnej
     Set pt = ActiveSheet.PivotTables(1)
     Set ptr = pt.TableRange1
     
    ' Add a new chart sheet - dodwanie nowego wykresu
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.ChartType = xlColumnClustered
        ActiveChart.SetSourceData Source:=ptr


    End Sub

    0 1
  • #2 24 Lis 2015 13:31
    arekkrasnal
    Poziom 20  

    Witam
    Podaj przykładowe dane.

    0