macro somma celle di valori duplicati

Versione Completa Stampa Cerca Utenti Iscriviti Condividi :

Excel Forum » Excel Forum » » Soluzioni Excel Domande e Risposte

c.luinetti

00giovedì 2 marzo 2017 10:32

ciao a tutti
sapreste aiutarmi a creare una macro che esegua questo ?

nella colonna A (commesse ) colonna B ( lotto ) colonna c ( ore )

commessalotto ore
A 21 3
B 65 4
A 21 5
A 22 6
E 55 7
D 24 8
D 23 9
D 24 10

la macro dovrebbe restituirmi i valori i valori univoci con le somme delle ore.
cio' i valori duplicati della colonna A associati ai valori duplicati della colonna vanno sommate le ore. come se fosse una pivot, ma non voglio fare una macro che esegua una pivot.
il risultato sopra dovrebbe essere:

commessalotto ore
A 21 8
A 22 6
B 65 4
E 55 7
D 24 18
D 23 9
grazie
Claudio

patel45

00giovedì 2 marzo 2017 17:32

Sub lotto()
LR = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:C" & LR).Copy Range("E1")
With ActiveSheet.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range( _
        "E2:E" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
      .SortFields.Add Key:=Range( _
        "F2:F" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
      .SetRange Range("E1:G" & LR)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
End With
r = 3
While Cells(r, "E") <> ""
  If Cells(r, "E") = Cells(r - 1, "E") And Cells(r, "F") = Cells(r - 1, "F") Then
    Cells(r - 1, "G").Value = Cells(r - 1, "G").Value + Cells(r, "G").Value
    Range("E" & r + 1 & ":G" & LR).Cut Cells(r, "E")
  End If
  r = r + 1
Wend
End Sub

GiuseppeMN

00venerdì 3 marzo 2017 09:42

Buona giornata, C.Luinetti;
leggo solo ora.

La mia proposta è:
- un pò di VBA

Option Explicit

Sub Analizza()
Application.ScreenUpdating = False
    Range("$E$1:$F$8").ClearContents
    Range("A1:B8").Copy Range("E1")
    ActiveSheet.Range("$E$1:$F$8").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("E1:E8"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("E1:F8")
        .Apply
    End With
Application.CutCopyMode = False
    Cells(1, 1).Select
End Sub

- in Cella "G1", la Formula

 =SE($E1="";"";SOMMA.PIÙ.SE($C$1:$C$8;$A$1:$A$8;$E1;$B$1:$B$8;$F1))

da copiare nelle Celle sottostanti.
L'applicazione delle Formule può essere automatizzata implementando il Codice VBA; dipende dal reale numero di Record da valutare.

A disposizione.

Buon Lavoro e buona serata.

Giuseppe

c.luinetti

00lunedì 6 marzo 2017 10:56

macro somma celle di valori duplicati

Grazie Patel45 e GiuseppeMN per il vostro aiuto.

sto adattando la soluzione scritta da Patel45 che è perfetta per la mia esigenza.

Patel45, ti allego il mio foglio xls perchè avrei un piccolo problemino.

io compilo regolarmente le colonne (Commessa, lotto e ore ) evidenziate in giallo.

La tua macro poi mi esegue un riassunto riportando la somma delle ore per le commesse e lotti uguali e scrivendo questi una sola volta. ( questo è lo scopo )

ma la macro è come se lavorasse a coppie di celle, se ho 3 valori uguali di commesse e lotti non li raggruppa.

se guardi il mio esempio lo capisci subito.
guarda le celle evidenziate il blu, sarebbero dovute essere raggruppatein una sola riga ( perchè commessa e lotto uguali ) con la rispettiva somma delle ore, invece lo ha fatto solo per le prime due commesse/lotto

nella macro è messo qualche registrazione per impaginare il risultato finale.
grazie

Claudio

patel45

00lunedì 6 marzo 2017 17:19

prova così

While Cells(r, "M") <> ""
  If Cells(r, "M") = Cells(r - 1, "M") And Cells(r, "N") = Cells(r - 1, "N") Then
    Cells(r - 1, "O").Value = Cells(r - 1, "O").Value + Cells(r, "O").Value
    Range("M" & r + 1 & ":O" & LR).Cut Cells(r, "M")
  Else
    r = r + 1
  End If
Wend

c.luinetti

00martedì 7 marzo 2017 10:39

macro somma celle di valori duplicati

grazie mille Patel45

la macro esegue esattamente ciò che volevo.

Claudio

Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 23:10.