venerdì 3 agosto 2018

vba controlla e cancella righe duplicate e somma i valori

'

Option Explicit

'

' controlla e cancella righe duplicate e somma i valori

' esegue il controllo su due colonne, se entrambi i valori sono uguali

' somma gli importi presenti

'

Sub DueduplicaticancellaSomma()

'

Dim corrente1, corrente2, colonna1, colonna2, conta

Dim indietro, precedente1, precedente2, importo1, importo2, totale

'

Dim foglio, quanterighe, quantecolonne

'

Set foglio = Sheets("report")

foglio.Activate

'

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

quantecolonne = Range(foglio.UsedRange.Cells(1, foglio.UsedRange.Columns.Count).Address).Column

'

Application.Cursor = xlWait

Application.ScreenUpdating = False

'

'

For conta = quanterighe To 1 Step -1                               ' conteggio righe usate

    corrente1 = Trim(ActiveSheet.Cells(conta, "B").Value)

    corrente2 = Trim(ActiveSheet.Cells(conta, "I").Value)

    importo1 = Trim(ActiveSheet.Cells(conta, "D").Value)

    indietro = conta - 1

    If indietro < 1 Then

       Exit For

    End If

    precedente1 = Trim(ActiveSheet.Cells(indietro, "B").Value)

    precedente2 = Trim(ActiveSheet.Cells(indietro, "I").Value)

    importo2 = Trim(ActiveSheet.Cells(indietro, "D").Value)

    If corrente1 = precedente1 Then

       If corrente2 = precedente2 Then

          If IsNumeric(importo1) = True And IsNumeric(importo2) = True Then

             totale = 0

             totale = CCur(importo1) + CCur(importo2)

             ActiveSheet.Cells(indietro, "D").Value = CCur(totale)

             totale = 0

          End If

          ActiveSheet.Rows(conta).Delete

       End If

    End If

'

Next conta

'

 

'

Application.ScreenUpdating = True

Application.Cursor = xlDefault

'

 

End Sub

 

 

Nessun commento:

Posta un commento