Ciao a tutti,

con il codice sotto riportato organizzo i dati presenti nei file in allegato così come sono.

Cioè, per valori di F maggiori oppure uguali a zero  viene effettuata una unica somma della colonna J nella colonna K.

Per valori negativi, viene effettuata la somma parziale dei singoli valori,  se diversi tra loro altrimenti raggruppati se uguali.

Ho un problema, però.

Sub InserisciTotali()
Dim uR As Long, iR As Long
Dim Sh As Worksheet
Dim iStart As Long, iEnd As Long
Dim Expire As BooleanApplication.ScreenUpdating = True

Set Sh = ActiveSheet 'NewWK

With Sh
uR = Sh.Range("A" & Rows.Count).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add _
Key:=Range("F2:F" & uR), _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:K" & uR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

iR = 2
iStart = 2
Do Until Sh.Cells(iR, 6) < = 0
iR = iR + 1
Loop
If iR > 2 Then
iEnd = iR - 1
Expire = Sh.Cells(iR - 1, 6) >= 0
InsertRow iR, iStart, iEnd, Expire
iR = iR + 1
iStart = iR
End If
Do Until Sh.Cells(iR, 6) <> Sh.Cells(iR + 1, 6) Or Sh.Cells(iR, 6) = ""
iR = iR + 1
Loop
iR = iR + 1
iEnd = iR - 1
Expire = Sh.Cells(iR - 1, 6) >= 0
InsertRow iR, iStart, iEnd, Expire
iR = iR + 1
iStart = iR
Do Until Sh.Cells(iR, 1) = ""
Do Until Sh.Cells(iR, 6) <> Sh.Cells(iR + 1, 6)
iR = iR + 1
Loop
iEnd = iR
iR = iR + 1Expire = Sh.Cells(iR - 1, 6) >= 0
InsertRow iR, iStart, iEnd, Expire
iR = iR + 1
iStart = iR
Loop
InsertTotal iR, iR - 2
'Legenda
End With
Set Sh = Nothing
Application.ScreenUpdating = False
End Sub
Private Sub InsertRow(iR As Long, iStart As Long, iEnd As Long, Scaduto As Boolean)
Rows(iR).Insert Shift:=xlDown
Range("J" & iR & ":K" & iR).Font.Bold = True
If Scaduto = True Then
Range("K" & iR).FormulaR1C1 = "=SUM(R[-" & iStart + 1 & "]C[-1]:R[-1]C[-1])"
Range("J" & iR) = "SCADUTO AD OGGI"
Range("J" & iR).Interior.ColorIndex = 8
Range("I" & iR).Interior.ColorIndex = 8
Range("J" & iR).Font.Size = 11
Range("K" & iR).Interior.ColorIndex = 22
Range("K" & iR).NumberFormat = "$ #,##0.00"
Range("K" & iR).Font.Size = 11
ElseIf Scaduto = False Then
Range("J" & iR) = "In scadenza al " & Format(Cells(iEnd, 5), "dd/mm/yyyy")
Else
Range("J" & iR) = "OGGI "
End If
Range("K" & iR).FormulaR1C1 = "=SUM(R[-" & iEnd - iStart + 1 & "]C[-1]:R[-1]C[-1])"
Range("K" & iR).NumberFormat = "$ #,##0.00"End Sub
Private Sub InsertTotal(iR As Long, iStart As Long)
Rows(iR & ":" & iR + 1).Insert Shift:=xlDown
Range("I" & iR + 1 & ":J" & iR + 1).Interior.ColorIndex = 40
Range("I" & iR + 1 & ":K" & iR + 1).Font.Bold = True
Range("I" & iR + 1 & ":K" & iR + 1).NumberFormat = "$ #,##0.00"
Range("I" & iR + 1 & ":K" & iR + 1).Font.Size = 11
Range("J" & iR + 1).HorizontalAlignment = xlRight
Range("J" & iR + 1) = "TOTALE COMPLESSIVO"
Range("J" & iR + 1).Font.Size = 12
Range("K" & iR + 1).FormulaR1C1 = "=SUM(R[-" & iStart & "]C:R[-1]C)"
Range("K" & iR + 1).Interior.ColorIndex = 45
Range("K" & iR + 1).NumberFormat = "$ #,##0.00"
Range("K" & iR + 1).Font.Size = 12
Range("K" & iR + 1).EntireColumn.AutoFit
End Sub

La variabile SCADUTO è di tipo boolean, quindi può essere VERA oppure FALSA, ed è legata alla variabile "giorni di ritardo" che può essere >= a zero oppure <

di zero.
Ho la necessità che assuma invece i tre valori distinti, come nel file ZETA, con la dicitura "In scadenza OGGI".Inoltre, nel file HAKKA, se la somma della colonna K è uguale a zero, allora la dicitura dovrà essere "IMPORTO DA COMPENSARE".Potreste darmi qualche suggerimento?

Spero di si.

Grazie mille.

Saluti,
PDA