Moderatori: Anthony47, Flash30005
Sub TrovaAgg()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
'Ws2.Range("K8:K1000").ClearContents
For CCA = 3 To 48 Step 5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Ambo = ""
If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
For NV = 1 To 5
For NP = 1 To 5
If VNA(NV) = Ws2.Cells(RR1, 3 + NP).Value Then
Ambo = Ambo & " - " & VNA(NV)
End If
Next NP
Next NV
End If
If Ws2.Cells(RR1, 12).Value < Ws1.Range("A2").Value Then
DiffRit = Ws1.Range("A2").Value - Ws2.Cells(RR1, 9).Value
RuA2 = UCase(Trim(Ws2.Range("B" & RR1).Value))
If RuA = RuA2 Then
If Len(Ambo) > 5 Then
If Ws2.Cells(RR1, 11).Value = "" Then
Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
Ws2.Cells(RR1, 10).Value = DiffRit
Ws2.Cells(RR1, 14).Value = "Sto"
Ws2.Cells(RR1, 11).Value = Trim(Mid(Ambo, 3, Len(Ambo)))
Ws2.Cells(RR1, 16).Value = "Positivo"
Ws2.Cells(RR1, 15).Value = "Ambo"
If Len(Ws2.Cells(RR1, 11).Value) > 8 Then Ws2.Cells(RR1, 15).Value = "Terno"
If Len(Ws2.Cells(RR1, 11).Value) > 13 Then Ws2.Cells(RR1, 15).Value = "Quaterna"
End If
Else
Ws2.Cells(RR1, 10).Value = DiffRit
Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
End If
End If
End If
Next RR1
Next CCA
End Sub
Sub TrovaAgg()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
AggS = 0
'Ws2.Range("K8:K1000").ClearContents
For CCA = 3 To 48 Step 5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Ambo = ""
If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
For NV = 1 To 5
For NP = 1 To 5
If VNA(NV) = Ws2.Cells(RR1, 3 + NP).Value Then
Ambo = Ambo & " - " & VNA(NV)
End If
Next NP
Next NV
End If
If Ws2.Cells(RR1, 12).Value < Ws1.Range("A2").Value Then
AggS = 1
DiffRit = Ws1.Range("A2").Value - Ws2.Cells(RR1, 9).Value
RuA2 = UCase(Trim(Ws2.Range("B" & RR1).Value))
If RuA = RuA2 Then
If Len(Ambo) > 5 Then
If Ws2.Cells(RR1, 11).Value = "" Then
Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
Ws2.Cells(RR1, 10).Value = DiffRit
Ws2.Cells(RR1, 14).Value = "Sto"
Ws2.Cells(RR1, 11).Value = Trim(Mid(Ambo, 3, Len(Ambo)))
Ws2.Cells(RR1, 16).Value = "Positivo"
Ws2.Cells(RR1, 15).Value = "Ambo"
If Len(Ws2.Cells(RR1, 11).Value) > 8 Then Ws2.Cells(RR1, 15).Value = "Terno"
If Len(Ws2.Cells(RR1, 11).Value) > 13 Then Ws2.Cells(RR1, 15).Value = "Quaterna"
End If
Else
If Ws2.Cells(RR1, 11).Value = "" Then
Ws2.Cells(RR1, 10).Value = DiffRit
Ws2.Cells(RR1, 12).Value = Ws1.Range("A2").Value
Ws2.Cells(RR1, 13).Value = CDate(Ws1.Range("B2").Value)
End If
End If
End If
End If
Next RR1
Next CCA
If AggS = 1 Then TrovaSpia
End Sub
Sub TrovaSpia()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
For CCA = 48 To 3 Step -5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NV = 5 To 1 Step -1
For RR1 = NewR To 8 Step -1
If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
If VNA(NV) = Ws2.Cells(RR1, 3).Value Then
Rows(RR1 + 1 & ":" & RR1 + 1).Insert Shift:=xlDown
Ws2.Range("A" & RR1 & ":P" & RR1).Copy Destination:=Ws2.Range("A" & RR1 + 1)
Application.CutCopyMode = False
Ws2.Range("I" & RR1 + 1).Value = Ws1.Range("A2").Value
Ws2.Cells(RR1 + 1, 13).Value = CDate(Ws1.Range("B2").Value)
Ws2.Range("J" & RR1 + 1).Value = 0
NewR = RR1
GoTo SaltaNV
End If
End If
Next RR1
SaltaNV:
Next NV
Next CCA
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Range("A" & RR1).Value = RR1 - 7
Next RR1
End Sub
Sub TrovaSpia()
Set Ws1 = Worksheets("Archivio")
Set Ws2 = Worksheets("Attuali")
For CCA = 48 To 3 Step -5
Dim VNA(90) As Integer
RuA = UCase(Trim(Ws1.Cells(1, CCA)))
For NV = 1 To 90
For Onu = 1 To 5
If NV = Ws1.Cells(2, CCA + Onu - 1).Value Then VNA(Onu) = Ws1.Cells(2, CCA + Onu - 1).Value
Next Onu
Next NV
NewR = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For NV = 5 To 1 Step -1
For RR1 = NewR To 8 Step -1
If UCase(Trim(Ws2.Range("B" & RR1).Value)) = UCase(Trim(RuA)) Then
MsgBox VNA(NV) - Ws2.Cells(RR1, 3).Value & "'" & Trim(Ws2.Range("N" & RR1).Value) & "'"
If VNA(NV) = Ws2.Cells(RR1, 3).Value And Trim(Ws2.Range("N" & RR1).Value) <> "Sto" Then
Rows(RR1 + 1 & ":" & RR1 + 1).Insert Shift:=xlDown
Ws2.Range("A" & RR1 & ":P" & RR1).Copy Destination:=Ws2.Range("A" & RR1 + 1)
Application.CutCopyMode = False
Ws2.Range("I" & RR1 + 1).Value = Ws1.Range("A2").Value
Ws2.Cells(RR1 + 1, 13).Value = CDate(Ws1.Range("B2").Value)
Ws2.Range("J" & RR1 + 1).Value = 0
NewR = RR1
GoTo SaltaNV
End If
End If
Next RR1
SaltaNV:
Next NV
Next CCA
UR1 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
For RR1 = 8 To UR1
Range("A" & RR1).Value = RR1 - 7
Next RR1
End Sub
Mentre ila spia 77 su Cagliari estrazione 8754 non deve essere inserita perché il 77 in quella estrazione non è uscito.
MsgBox VNA(NV) - Ws2.Cells(RR1, 3).Value & "'" & Trim(Ws2.Range("N" & RR1).Value) & "'"
Torna a Applicazioni Office Windows
Macro che scatta quando cambia dato in un altro file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 11 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Macro che ricerca combinazioni che danno un valore Autore: kar64 |
Forum: Applicazioni Office Windows Risposte: 10 |
Macro che indica la riga prima della cella attiva Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 19 |
Visitano il forum: Nessuno e 56 ospiti