Pivot difficile

Hai un problema con Excel?

Nuova discussione

Pivot difficile
di carlolomba (utente non iscritto) data: 20/09/2017 13:35:20
Ciao a tutti,
1) ho creato una pivot con vba, con 4 filtri. se nn definisco nulla di particolare in automatico mi viene lasciata una riga vuota (la 5) e dopo dalla 6 cominciano le etichette delle righe e poi di seguto tutte le righe con i dati. Io vorrei che le etichette e le righe partissero dopo 3 righe vuote (devo mettere una legenda nelle righe prima delle etichette). sapete come posso fare?

2) sapete se se un modo per inizializzare a zero più variabili numeriche con una sola riga invece di muovere zero una x una le variabili?

Allego la sub per la creazione della pivot.

Sub Creo_pivot1(Nome_sheet, almenoUNO As String)
    Application.ScreenUpdating = False
    Dim MyDate, Data_vis, mesepiv As Date
    MyDate = Date
    Data_vis = Date
    MyDate = Format(MyDate, "dd_mm_yy")
    almenoUNO = 1
    Dim MesiUnione(12)
    Dim mesi_ris
    Dim ind_mesi, ind, numcolPiv, numrigPiv, colonna, riga, colPivNumero, rigaPiv As Long
    Dim Availab, a, colPivLet, colPivLettera, descriz_prova As String
    
    Dim tot_bench, tot_over, tot_partial, tot_under, tot_ok As Long
    Dim totale_bench, totale_over, totale_partial, totale_under, totale_ok As Integer
    
    ind_mesi = 67 ' attenzione a qs colonna WRap ha già modificato più volte la posizione
    
    Sheets(2).Select
    For ind = 1 To 12
        mesepiv = Sheets(2).Cells(1, ind_mesi)
        MesiUnione(ind) = Format(mesepiv, "mmm-yy")
        ind_mesi = ind_mesi + 1
    Next ind

    Dim numcol, numrow As Long
    Dim Nome_sheet_pivot As String
    Nome_sheet_pivot = "Demand Resources " & codeITOABS
    numcol = (Worksheets(Nome_sheet).Cells(1, Columns.Count).End(xlToLeft).Column)
    numrow = (Worksheets(Nome_sheet).Cells(Application.Rows.Count, 7).End(xlUp).Row) 'testo la colonna Portfolio per righe piene
    Worksheets.Add(after:=Sheets(Worksheets.Count)).Name = Nome_sheet_pivot
    Sheets(Nome_sheet_pivot).Select
    With ActiveWorkbook.Sheets(Nome_sheet_pivot).Tab
        .ColorIndex = 45
        .TintAndShade = 0
    End With
  
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Nome_sheet & "!R1C1:R" & numrow & "C" & numcol, Version:=xlPivotTableVersion15).CreatePivotTable _
        TableDestination:="'" & Nome_sheet_pivot & "'!R1C1", TableName:="PivotTable1", _
        DefaultVersion:=xlPivotTableVersion15

    Sheets(Nome_sheet_pivot).Select
    'ActiveWindow.SmallScroll Down:=3
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Portfolio")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Owning Country")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Payroll Country")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Manager Name")
        .Orientation = xlPageField
       ' .LayoutBlankLine = True
       ' .LayoutForm = xlTabular
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Resource Name")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Resource Name"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Resource Name"). _
        LayoutForm = xlTabular
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Resource Name"). _
        PivotFilters.Add2 Type:=xlCaptionDoesNotEqual, Value1:="PromiseResource"
    'ActiveSheet.PivotTables("PivotTable1").PivotFields("Resource Name"). _
        PivotFilters.Add3 Type:=xlCaptionDoesNotEqual, Value1:=""
    
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Employee ID")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Employee ID").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Employee ID"). _
        LayoutForm = xlTabular
    
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Availability")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Availability").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Project Name")
        .Orientation = xlRowField
        .Position = 4
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Project Name").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Availability").ShowDetail = False
    For ind = 1 To 12
   ' inserisce MESI in pivot
      mesi_ris = MesiUnione(ind)
      ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields(mesi_ris), " " & mesi_ris, xlSum

      With ActiveSheet.PivotTables("PivotTable1").PivotFields(mesi_ris)
        .Caption = mesi_ris
      End With
    Next
    Application.ScreenUpdating = True

'formatto dati
    Rows("6:6").Select
    Selection.Replace what:="Etichette di riga", Replacement:="RESOURCE NAME", LookAt:=xlPart, _
        searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Columns("C:O").Select
    With Selection
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
         .NumberFormat = "0.00"
    End With
    Rows("1:5").Select
    With Selection
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
         .NumberFormat = "0"
    End With
    
    Rows("6:6").Select
' nasconde list pivot e cambia formattazione righe e colonne
    ActiveWorkbook.ShowPivotTableFieldList = False
    Cells.Select
    ActiveSheet.PivotTables("PivotTable1").ShowTableStyleColumnStripes = True
    ActiveSheet.PivotTables("PivotTable1").ShowTableStyleRowStripes = True
' ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "MyPivotStyleMedium2 2"
    ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "MyPivotStyleReport3 2"
' toglie griglia da foglio con Pivot
    ActiveWindow.DisplayGridlines = False
    
' conta righe e colonne pivot
    numcolPiv = Worksheets(Nome_sheet_pivot).Cells(6, Columns.Count).End(xlToLeft).Column
    numrigPiv = Worksheets(Nome_sheet_pivot).Cells(Rows.Count, 1).End(xlUp).Row - 1
' da riga 4 ad ultima e per tutte le colonne formatta in base a valori
    For riga = 7 To numrigPiv
        tot_bench = 0
        tot_over = 0
        tot_partial = 0
        tot_under = 0
        tot_ok = 0
        For colonna = 4 To numcolPiv
            Availab = Cells(riga, 3)
            a = Worksheets(Nome_sheet_pivot).Cells(riga, colonna).Value
            Cells(riga, colonna).Select
            If a = "" Then
                tot_bench = 1
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ColorIndex = 45
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            End If
            If a = Availab Then tot_ok = 1: GoTo proseguo_format
            If a > Availab Then
                  tot_over = 1
                  Selection.Font.Bold = True
                  Selection.Font.Color = 255
                  GoTo proseguo_format
            End If
            If (a > "0,00" And a <= "0,49") Then
                tot_partial = 1
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ColorIndex = 40
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            End If
            If (a > "0,49" And a <= "0,79") Then
                tot_under = 1
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ColorIndex = 36
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            End If
proseguo_format:
        Next
        If tot_bench = 1 And tot_partial = 0 And tot_under = 0 And tot_over = 0 And tot_ok = 0 Then totale_bench = totale_bench + 1: GoTo altro_rec
        If tot_over = 1 Then totale_over = totale_over + 1: GoTo altro_rec
        If tot_partial = 1 Then totale_partial = totale_partial + 1: GoTo altro_rec
        If tot_under = 1 Then totale_under = totale_under + 1: GoTo altro_rec
        totale_ok = totale_ok + 1
altro_rec:
     Next
' inserisce legenda x colori e valori
    Rows("1:1").Select
' trovo n° ultima colonna blank
    colPivNumero = Selection.Cells(1, Selection.Columns.Count).End(xlToLeft).Column + 3
    colPivLet = Cells(1, colPivNumero).Address(True, False)
    colPivLettera = Split(colPivLet, "$")(0)
    rigaPiv = 1
    Range(Cells(rigaPiv, colPivNumero - 1), Cells(rigaPiv, colPivNumero - 1)).Select
    Range(Cells(rigaPiv, colPivNumero - 1), Cells(rigaPiv + 4, colPivNumero - 1)).MergeCells = True
    With Selection.Font
            .Bold = True
            .Size = 12.5
            .TintAndShade = 0
    End With
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
    End With
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
    End With
    descriz_prova = "Legenda" & Chr(13) & Chr(10) & "e" & Chr(13) & Chr(10) & "Totali"
    ActiveCell.FormulaR1C1 = descriz_prova
    
    Range(Cells(rigaPiv, colPivNumero), Cells(rigaPiv, colPivNumero + 2)).Select
    With Selection.Font
            .Bold = True
            .Color = 255
            .TintAndShade = 0
    End With
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
    End With
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
    End With
    Range(Cells(rigaPiv, colPivNumero), Cells(rigaPiv, colPivNumero)).Select
    ActiveCell.FormulaR1C1 = totale_over
    Range(Cells(rigaPiv, colPivNumero + 1), Cells(rigaPiv, colPivNumero + 1)).Select
    ActiveCell.FormulaR1C1 = "Overallocation"
    Range(Cells(rigaPiv, colPivNumero + 2), Cells(rigaPiv, colPivNumero + 2)).Select
    ActiveCell.FormulaR1C1 = "'> Availability"

    Range(Cells(rigaPiv + 1, colPivNumero), Cells(rigaPiv + 1, colPivNumero + 2)).Select
    With Selection.Font
            .Bold = True
            .ColorIndex = 5
            .TintAndShade = 0
    End With
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
    End With
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
    End With
    Range(Cells(rigaPiv + 1, colPivNumero), Cells(rigaPiv + 1, colPivNumero)).Select
    ActiveCell.FormulaR1C1 = totale_ok
    Range(Cells(rigaPiv + 1, colPivNumero + 1), Cells(rigaPiv + 1, colPivNumero + 1)).Select
    ActiveCell.FormulaR1C1 = "Filled"
    Range(Cells(rigaPiv + 1, colPivNumero + 2), Cells(rigaPiv + 1, colPivNumero + 2)).Select
    ActiveCell.FormulaR1C1 = "0,80>=<1,00"

    Range(Cells(rigaPiv + 2, colPivNumero), Cells(rigaPiv + 2, colPivNumero + 2)).Select
    With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 36
            .TintAndShade = 0
            .PatternTintAndShade = 0
    End With
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
    End With
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
    End With
    Range(Cells(rigaPiv + 2, colPivNumero), Cells(rigaPiv + 2, colPivNumero)).Select
    ActiveCell.FormulaR1C1 = totale_under
    Range(Cells(rigaPiv + 2, colPivNumero + 1), Cells(rigaPiv + 2, colPivNumero + 1)).Select
    ActiveCell.FormulaR1C1 = "Underallocation"
    Range(Cells(rigaPiv + 2, colPivNumero + 2), Cells(rigaPiv + 2, colPivNumero + 2)).Select
    ActiveCell.FormulaR1C1 = "0,50>=<0,79"
    
    Range(Cells(rigaPiv + 3, colPivNumero), Cells(rigaPiv + 3, colPivNumero + 2)).Select
    With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 40
            .TintAndShade = 0
            .PatternTintAndShade = 0
    End With
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
    End With
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
    End With
    Range(Cells(rigaPiv + 3, colPivNumero), Cells(rigaPiv + 3, colPivNumero)).Select
    ActiveCell.FormulaR1C1 = totale_partial
    Range(Cells(rigaPiv + 3, colPivNumero + 1), Cells(rigaPiv + 3, colPivNumero + 1)).Select
    ActiveCell.FormulaR1C1 = "Partial Bench"
    Range(Cells(rigaPiv + 3, colPivNumero + 2), Cells(rigaPiv + 3, colPivNumero + 2)).Select
    ActiveCell.FormulaR1C1 = "<=0,49"
    
    Range(Cells(rigaPiv + 4, colPivNumero), Cells(rigaPiv + 4, colPivNumero + 2)).Select
    With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 45
            .TintAndShade = 0
            .PatternTintAndShade = 0
    End With
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
    End With
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
    End With
    Range(Cells(rigaPiv + 4, colPivNumero), Cells(rigaPiv + 4, colPivNumero)).Select
    ActiveCell.FormulaR1C1 = totale_bench
    Range(Cells(rigaPiv + 4, colPivNumero + 1), Cells(rigaPiv + 4, colPivNumero + 1)).Select
    ActiveCell.FormulaR1C1 = "Bench"

    Columns("A:O").Select
    Columns("A:O").EntireColumn.AutoFit

    ThisWorkbook.Worksheets(Nome_sheet_pivot).Cells.EntireColumn.AutoFit
    Rows("7:7").Select
    ActiveWindow.FreezePanes = True ' blocca le righe iniziali per lo scrolling
    
    Application.ScreenUpdating = True
End Sub

di Vecchio Frac data: 20/09/2017 21:48:20
Questa discussione è sufficientemente enigmatica da stuzzicarmi la curiosità ^_^
Riesci ad allegare un file di esempio?
La domanda numero 2 è piuttosto arcana... per inizializzare una variabile puoi usare Erase e successivo Dim. Se è una variabile oggetto puoi usare New.
Se hai molte variabili da resettare... devi fare il reset una per una. Ma non capisco il senso (applicato al contesto s'intende). Spiega quindi dove e perchè devi reinizializzare più variabili (e fai riferimento al tuo codice).
Pivot difficile
di carlolomba (utente non iscritto) data: 21/09/2017 11:00:28
nel file allegato, c'è il risultato della pivot creata col codice vba tramutata in lista, la descrizione della "legenda e totali" va a toccare l'etichetta dei mesi, non posso spostarla o cambiarla per motivi di utilizzo che nn sto a spiegare, io vorrei che la parte pivot dei dati partisse nn dalla riga 6 ma da una più sotto senza aggiungere filtri, migliorenado la leggibilità e che se un domani dovessi aggiungere un totale nella legenda, possa spostare nuovamente i dati più in basso. Ora le etichette alla riga 6 vengono messe in automatico da excel lasciando una riga vuota dopo i filtri descritti. E' possibile da vba, impostare la riga dove mettere le etichette e di seguito i dati?

Ne aprofitto per chiederVi, se dalla lista voglio evidenziare solo i "bech" (i nomi che hanno tutti i mesi a spazi) o i Partial bench o altri, con un bottone o un tipo filtro che agisca e verifichi le celle dei mesi e me li estrappola visualizzandoli?

Vuoi Approfondire?