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

 

 

ricerca parametri pseudo xml

'

'  ricerca parametri

'  gestione di un file parametri

'  ricerca tramite espressione regolare.

'  il file parametri ha la struttura similare ad  un file xml.

'  utilizzato per sopperire alle incoerenza dei file xml che non posso contenere tag numerici,

'

option explicit

'

dim htmlrisposta

'

htmlrisposta = cercaParametrihtml(182, "natura")

'

msgbox "finale: " & htmlrisposta

'

' ===============

'

'

' ===============

'

Function informazioni(precord, pcampo)

dim parchivio, strHTML

parchivio= '"C:\lavoro-2016\db-informazioni.xml"

parchivio= dbinformazioni

dim filesys, readfile, jtxt

set filesys = CreateObject ("Scripting.FileSystemObject")

 

If (filesys.FileExists(parchivio)) Then

      'msg = filespec & " esiste."

       set readfile = filesys.OpenTextFile(parchivio, 1, false)

       strHTML = readfile.ReadAll

Else

      'msg = filespec & " Non esiste."

       Set readfile = filesys.CreateTextFile(pArchivio, TRUE)

       '

       jtxt = "<vuoto>mancano paramenti</vuoto>"

       readfile.WriteLine(jtxt)

       strHTML = jtxt

End If

'

readfile.close

'

dim oRegex, criterio, trovatocampo, trovatorecord

set oRegex = CreateObject("vbscript.regexp")

oRegex.Global = 1

oRegex.Multiline = 1

oRegex.IgnoreCase = 1

'

trovatocampo = ""

trovatorecord = ""

' ----

criterio = "<" & precord & ">((?:.|\n|\r)*?)</" &  precord & ">"

'

oRegex.Pattern = criterio

If oRegex.Test(strHTML) = true Then

   trovatorecord = oRegex.Execute(strHTML).item(0).SubMatches.item(0)

else

   trovatorecord = ""

end if

' ---

criterio = "<" & pcampo & ">((?:.|\n|\r)*?)</" &  pcampo & ">"

'

oRegex.Pattern = criterio

If oRegex.Test(trovatorecord) = true Then

   trovatocampo = oRegex.Execute(trovatorecord).item(0).SubMatches.item(0)

else

   trovatocampo = ""

end if

'

informazioni = trovatocampo

'

end Function

'

'=====

'

‘

‘ esempio del file db-informazioni.xml

‘

<fatturaelettronica>

 

<dadef1>

 <natura>N1</natura>

 <RiferimentoNormativo>RiferimentoNormativo</RiferimentoNormativo> 

 <agenzia> N1 escluse ex art. 15 <agenzia>

</dadef1>

 

<dadef2>

 <natura>N2</natura>

 <RiferimentoNormativo>RiferimentoNormativo</RiferimentoNormativo> 

 <agenzia> N2 non soggette <agenzia>

</dadef2>

 

<182>

 <natura>N3</natura>

 <RiferimentoNormativo>Non imponibile per dichiarazione di intento art 8 2c dpr 633-72</RiferimentoNormativo>

 <agenzia>N3 non imponibili </agenzia>

</182>

 

<dadef3>

 <natura>N4</natura>

 <RiferimentoNormativo>RiferimentoNormativo</RiferimentoNormativo> 

 <agenzia> N4 esenti  <agenzia>

</dadef3>

 

<dadef4>

 <natura>N5</natura>

 <RiferimentoNormativo>RiferimentoNormativo</RiferimentoNormativo> 

 <agenzia> N5 regime del margine  <agenzia>

</dadef4>

 

<dadef5>

 <natura>N6</natura>

 <RiferimentoNormativo>RiferimentoNormativo</RiferimentoNormativo> 

 <agenzia> N6 inversione contabile (reverse charge)  <agenzia>

</dadef5>

 

 

 

</fatturaelettronica>