Somma come Pivot

Hai un problema con Excel?

Nuova discussione

Somma come Pivot
di gugluca (utente non iscritto) data: 30/10/2013 12:16:42
Buongiorno a tutti,
Nel foglio1 ho una tabella fatta così:

Colonna A ColonnaB
alfa 10
alfa 20
beta 10
beta 20
beta 15
gamma 20

Vorrei che nel foglio2 si creasse con un ciclo vba 2 colonne fatte così:
ColonnaA ColonnaB
alfa 30
beta 45
gamma 20

Come posso fare ad inserire un ciclo che mi gruppi la colonnaA sommando la colonnaB nel foglio2?

Grazie in anticipo
Ciao

Luca
di Grograman data: 30/10/2013 14:41:44
ma una banalissima formula?
=SOMMA.SE(Foglio1!A:A;Foglio2!A2;Foglio1!B:B)
di gugluca (utente non iscritto) data: 31/10/2013 08:33:35
Ciao,
grazie per il suggerimento ma non è quello che intendo.
Il somma se potrebbe funzionare solo se il foglio2 contenesse già i valori della colonna A (ovviamente senza duplicati).
In realtà il foglio2 è vuoto.
E' come se nel foglio2 volessi fare una pivot.
Siccome che il foglio1 lo alimento con una macro che pesca da un file txt, volevo proseguire con l'alimentazione del foglio2 con la macro. La mia alternativa 'manuale' poteva essere quella di fare una pivot e poi fare un copia-incolla valori per eliminarla (ma immagino ci siano metodi migliori)...

di patel data: 31/10/2013 13:18:41
prova questa

Sub SplitToRangesNoBlanks1()
With Sheets(1)
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
rstart = 1
drow = 1
For r = 2 To lr + 1
  If .Cells(r, 1) <> .Cells(r - 1, 1) Then
    If rstart = 0 Then
      rstart = r
    Else
      rend = r - 1
      sum1 = Application.WorksheetFunction.Sum(.Range("B" & rstart & ":B" & rend))
      Sheets(2).Cells(drow, 1) = .Range("A" & rstart)
      Sheets(2).Cells(drow, 2) = sum1 
      rstart = r
      drow = drow + 1
    End If
  End If
Next
End With
End Sub

di Grograman data: 31/10/2013 15:07:46
Io farei fare la pivot a excel appena dopo aver importato il txt
di gugluca (utente non iscritto) data: 31/10/2013 15:25:31
Grazie per il suggerimento patel.
Il codice funziona, direi che va abbastanza bene.
Unica cosa, se i dati non sono ordinati, non riesce a grupparli completamente.

Hai qualche suggerimento per l'ordinamento?

Grazie ancora

Ciao

Luca

di Grograman data: 31/10/2013 16:36:04
Ciao!
Mi permetto di insistere e allego un esempio molto semplificato da un taglia e cuci di altro codice che riporto

Option Explicit
Sub Nomesub()
  Dim wb As Workbook
  Dim ws As Worksheet
  
  Dim x As Long
  Dim rngC As Range, cella As Range
  
  Dim oPVT As PivotTable
  
  Set wb = ThisWorkbook
  Set ws = wb.Sheets(1)
  
    For Each oPVT In ws.PivotTables
      oPVT.TableRange2.Clear
    Next oPVT
  
    With ws
      x = .Range("A" & .Rows.Count).End(xlUp).Row
      Set rngC = .Range(.Cells(1, 1), .Cells(x, 2))
      '''''''''''''''''''''''''''''''''''''''''''''
      Call Modulo1.Pivot_Saldat(ws, rngC) '''RICHIAMABILE IN QUALUNQUE MOMENTO
      '''''''''''''''''''''''''''''''''''''''''''''
      Set rngC = Nothing
    End With
  
  Set ws = Nothing
  Set wb = Nothing
End Sub
Sub Pivot_Saldat(ByVal wsDati As Worksheet, rngDati As Range)

    Dim oPvtCch As PivotCache
    Dim oPvtTbl As PivotTable
    Dim ptField As PivotField
    Dim ptItem As PivotItem

    Set oPvtCch = wsDati.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngDati)   'crea cache per tabella dal range
    Set oPvtTbl = oPvtCch.CreatePivotTable(wsDati.Cells(2, 7))  'crea pivot in nuovo foglio

    With oPvtTbl
        .RowAxisLayout xlOutlineRow
        .Name = wsDati.Name
        .PivotFields(1).Orientation = xlRowField    'Lato
        .PivotFields(1).Position = 1    'Lato come primo elemento
        For Each ptItem In .PivotFields(1).PivotItems
             If ptItem.Caption = "(blank)" Then ptItem.Visible = False
        Next
        .AddDataField .PivotFields(2), "Importo", xlSum    'Somma importo
        .SubtotalLocation xlAtTop
        For Each ptField In .RowFields    'elimino i subtotali
            If ptField.Name <> "Lato" Then
                On Error Resume Next
                ptField.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            End If
        Next ptField
    End With


    Set rngDati = Nothing
    Set oPvtCch = Nothing
    Set oPvtTbl = Nothing

End Sub

di patel data: 31/10/2013 19:03:37
ho aggiunto il sort

ub SplitToRangesNoBlanks1()
With Sheets(1)
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
Range("A1:B" & LR).Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo, DataOption1:=xlSortTextAsNumbers
rstart = 1
drow = 1
For r = 2 To LR + 1
  If .Cells(r, 1) <> .Cells(r - 1, 1) Then
    If rstart = 0 Then
      rstart = r
    Else
      rend = r - 1
      sum1 = Application.WorksheetFunction.Sum(.Range("B" & rstart & ":B" & rend))
      Sheets(2).Cells(drow, 1) = .Range("A" & rstart)
      Sheets(2).Cells(drow, 2) = sum1 '      Columns.AutoFit
      rstart = r
      drow = drow + 1
    End If
  End If
Next
End With
End Sub

di gugluca (utente non iscritto) data: 04/11/2013 08:29:18
Grazie ancora ragazzi,
funziona tutto alla grande!

Grazie per l'aiuto!

Alla prossima

Luca

Vuoi Approfondire?