Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Prosím o vytvoření makra v excelu.

Tak ak by Ťa to ešte zaujímalo (veľmi to na to nevyzerá), tak nasledujúce makro z X vstupných súborov v zdieľanom adresári s rovnakou štruktúrou dát v hárku s názvom "zdroj" (vystaval som to na niekoľko kópií mojej vzorovej tabuľky, ktorú som prikladal minule) vytvorí X hárkov kontingenčných tabuliek v "analyzačnom súbore" KT.xlsm, ktorý sa musí nachádzať tiež v onom zdieľanom adresári a ktorý obsahuje toto makro.
T.j. v súbore KT.xlsm sa spustením makra vytvárajú hárky kontingenčných tabuliek, zodpovedajúce príslušným vstupným čiastkovým súborom, pričom každý hárok dostane pridelený názov podľa názvu zdrojového súboru.
Nie je vylúčené vyhotovenie jednej sumarizačnej kontingenčnej tabuľky namiesto týchto individuálnych, ale keďže si sa neozval kvôli ďalším doplňujúcim informáciám, tak som narýchlo zbuchol takúto ukážku.
Po zmene vstupných údajov sa kontingenčné tabuľky samé neaktualizujú. Tu je to však vyriešené nie formou aktualizácie, ale vyhotovením celej analýzy nanovo, keďže k dispozícii môžu byť už iné súbory...

Sub Vypisy_KT()

    On Error GoTo Chyba
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ChDir ActiveWorkbook.Path
    
    If ActiveWorkbook.Sheets.Count > 1 Then
        For i = 1 To ActiveWorkbook.Sheets.Count - 1
            Sheets(1).Delete
        Next i
    End If
    
    Application.DisplayAlerts = True
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(ActiveWorkbook.Path)
    Set fc = f.Files
    
    i = 1
    j = 1
    
    For Each f1 In fc
    
        If f1.Name = "~$KT.xlsm" Or f1.Name = "KT.xlsm" Then GoTo Dalsi

        Sheets(j).Select
        Range("A1").Select

        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="[" & f1.Name & "]zdroj!R1C1:R10C3", _
        Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=Range("A1"), TableName:="KT" & i, DefaultVersion:=xlPivotTableVersion14
        ActiveSheet.Name = Left(f1.Name, Len(f1.Name) - 5)
        With ActiveSheet.PivotTables("KT" & i).PivotFields("názov")
            .Orientation = xlRowField
            .Position = 1
        End With
        ActiveSheet.PivotTables("KT" & i).AddDataField ActiveSheet.PivotTables("KT" & i).PivotFields("počet"), "Súčet z počet", xlSum
        With ActiveSheet.PivotTables("KT" & i).PivotFields("čas")
            .Orientation = xlRowField
            .Position = 2
        End With
        Cells(3, 1).Group Start:=True, End:=True, Periods:=Array(False, False, True, False, False, False, False)
        Sheets.Add After:=Sheets(Sheets.Count)

        j = j + 1
    
Dalsi:
        i = i + 1
    Next
    Sheets(1).Select
    Exit Sub

Chyba:
    MsgBox "Chyba"

End Sub

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny