Excel o macro (solita formula)

[Lucio Peruggini]

Il file l'ho già inviato, guarda il post delle 21,54 ma dev'esserti sfuggito.
Comunque questo è il link.
https://dl.dropbox.com/u/18220462/FILE/SPIA%20TT%20.zip

[Flash30005]

Ora dovrebbe andare bene

Codice: Seleziona tutto

    Sub TrRit()
    UR = Worksheets("SpiaTT").Range("A" & Rows.Count).End(xlUp).Row
    Worksheets("SpiaTT").Columns(5).ClearContents
    Worksheets("SpiaTT").[E1].Value = "Rit."
    Tr = 0
    For RR1 = 2 To UR
        If Worksheets("SpiaTT").Range("B" & RR1).Value = "Spia" And Tr = 0 Then
            Conc1 = Worksheets("SpiaTT").Range("A" & RR1).Value
            For RR2 = RR1 + 1 To UR
                If Worksheets("SpiaTT").Range("B" & RR2).Value = "" Then
                Tr = 0
                    Worksheets("SpiaTT").Range("E" & RR2).Value = Worksheets("SpiaTT").Range("A" & RR2).Value - Conc1
                    RR1 = RR2
                    GoTo SaltaRR2
                End If
            Next RR2
            Tr = 1
SaltaRR2:
        End If
    Next RR1
    End Sub

Il motivo era per una serie di stringhe Spia superiore alle 50 previste

ciao

[Lucio Peruggini]

Ciao Flash, probabilmente hai inserito la macro precedente; questa si blocca sempre in quel punto.
Comunque ho modificato portando a 100 il valore stringa di

For RR2 = RR1 + 1 To RR1 + 100

Ora funziona, grazie.
Ciao

[Flash30005]

Non è possibile che funzioni con RR1 + 100 e non con UR
comunque ho corretto il bug di scrittura quando c'è la riga bianca (es. riga 17296)

Codice: Seleziona tutto

Sub TrRit2()
For F = 1 To Worksheets.Count
UR = Worksheets(F).Range("A" & Rows.Count).End(xlUp).Row
Worksheets(F).Columns(5).ClearContents
Worksheets(F).[E1].Value = "Rit."
Tr = 0
For RR1 = 2 To UR
If Worksheets(F).Range("A" & RR1).Value <> "" Then
    If Worksheets(F).Range("B" & RR1).Value = "Spia" And Tr = 0 Then
        Conc1 = Worksheets(F).Range("A" & RR1).Value
        For RR2 = RR1 + 1 To UR
            If Worksheets(F).Range("B" & RR2).Value = "" Then
            Tr = 0
               If Worksheets(F).Range("A" & RR2).Value <> "" Then Worksheets(F).Range("E" & RR2).Value = Worksheets(F).Range("A" & RR2).Value - Conc1
                RR1 = RR2
                GoTo SaltaRR2
            End If
        Next RR2
        Tr = 1
SaltaRR2:
    End If
Else
Tr = 0
End If
Next RR1
Next F
End Sub


Ciao

[Lucio Peruggini]

Non è impossibile, funzionava ugualmente.
Comunque ho messo quest'ultima e funziona bene.
Grazie, ciao