Condividi:        

Aggiunta su macro

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Aggiunta su macro

Postdi Lucio P. » 03/06/09 01:38

Gentilmente potete aggiungere la operazione descritta nell'immagine? Grazie, Lucio



Immagine


Dim I As Integer, Ruote As Integer, Ur As Single
Dim BA As Integer, CA As Integer, FI As Integer, GE As Integer, MI As Integer
Dim NA As Integer, PA As Integer, RO As Integer, TOR As Integer, VE As Integer

Sub Lucio()
Ur = Range("A" & Rows.Count).End(xlUp).Row

'Ur = Range("A65536").End(xlUp).Row
Ruote = 0
I = 2
While I <= Ur
If OldN <> Cells(I, 1) And OldN <> "" Then '<<< *****Aggiunta MODIFICATA
'Ruote = 9: I = I - 1: GoTo NewN '<<< Aggiunta
Ruote = 10: I = I - 1: PLM = 1: GoTo NewN '<<< Aggiunta +A+A+A+A aggiunto PLM
End If

Select Case Cells(I, 2)
Case "Ba"
If BA = 1 Then
Cancella_Doppione I, Ur
Else
BA = 1
Ruote = Ruote + 1
End If
Case "Ca"
If CA = 1 Then
Cancella_Doppione I, Ur
Else
CA = 1
Ruote = Ruote + 1
End If
Case "Fi"
If FI = 1 Then
Cancella_Doppione I, Ur
Else
FI = 1
Ruote = Ruote + 1
End If
Case "Ge"
If GE = 1 Then
Cancella_Doppione I, Ur
Else
GE = 1
Ruote = Ruote + 1
End If
Case "Mi"
If MI = 1 Then
Cancella_Doppione I, Ur
Else
MI = 1
Ruote = Ruote + 1
End If
Case "Na"
If NA = 1 Then
Cancella_Doppione I, Ur
Else
NA = 1
Ruote = Ruote + 1
End If
Case "Pa"
If PA = 1 Then
Cancella_Doppione I, Ur
Else
PA = 1
Ruote = Ruote + 1
End If
Case "Ro"
If RO = 1 Then
Cancella_Doppione I, Ur
Else
RO = 1
Ruote = Ruote + 1
End If
Case "To"
If TOR = 1 Then
Cancella_Doppione I, Ur
Else
TOR = 1
Ruote = Ruote + 1
End If
Case "Ve"
If VE = 1 Then
Cancella_Doppione I, Ur
Else
VE = 1
Ruote = Ruote + 1
End If
End Select
NewN: '<<< Aggiunta

If Ruote = 10 Then
BA = 0: CA = 0: FI = 0: GE = 0: MI = 0: NA = 0: PA = 0: RO = 0: TOR = 0: VE = 0
Ruote = 0
OldN = Cells(I + 1, 1) '*******<<<< AGGIUNTA AGGIUNTA
If PLM = 0 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3) '<<<< +++++ +A+A+A+A Modificata, era If I>7

'If I > 7 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3) '<<<< +++++
End If
PLM = 0
I = I + 1
' OldN = Cells(I, 1) '<<< ******Aggiunta MODIFICATA, cioe' tolta
Wend



End Sub

Sub Cancella_Doppione(I, Ur)
Rows(I).Select
Selection.Delete Shift:=xlUp
Ur = Ur - 1
I = I - 1
End Sub
Lucio P.
Utente Junior
 
Post: 82
Iscritto il: 15/04/09 08:53

Sponsor
 

Re: Aggiunta su macro

Postdi Anthony47 » 03/06/09 13:30

Penso che dovrebbe bastare sostituire questa: If PLM = 0 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3) '<<<< +++++ +A+A+A+A Modificata, era If I>7
Con queste:
Codice: Seleziona tutto
If PLM = 0 Then
Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3)
Cells(I, 6) = Cells(I-1, 3) - Cells(I - 2, 3)
End if

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Aggiunta su macro

Postdi Lucio P. » 03/06/09 13:57

Beati voi cervelloni! Grazie, funziona benissimo.
Saluti, Lucio
Lucio P.
Utente Junior
 
Post: 82
Iscritto il: 15/04/09 08:53


Torna a Applicazioni Office Windows


Topic correlati a "Aggiunta su macro":


Chi c’è in linea

Visitano il forum: Nessuno e 49 ospiti