Tutto ciò esula dal tema della sezione "Applicazioni Office Windows"
puoi fare questa ricerca con una query su Google e studiare successivamente l'esigenza da proporre come quesito per risolvere con macro.
Ciao
Moderatori: Anthony47, Flash30005
..1) la modifica che hai apportato funziona per le due macro citate,
ma non può essere applicata alle prime due macro,
quella del 14/03/13 ore 22:38 e quella del 16/03/13 ore 14:11,
anche in queste macro si presenta l'anomalia che ho evidenziato nell'immagine del 18/03/13;
ricordo, che a differenza delle ultime due che cercano gli ambi su tutte le ruote,
la prime due invece cercano gli ambi su ruote consecutive e diametrali contemporaneamente;
facendo prove ho intuito che bisogna modificare la seguente linea:
If TRR = 2 Then ColIn = 25 + RRuota
ma ancora non sono riuscito a trovare la soluzione.
Sub CercaAmboConsec()
Worksheets("Archivio").Select
UR = Worksheets("Archivio").Range("C" & Rows.Count).End(xlUp).Row
Range("C5:BE" & UR).Interior.ColorIndex = xlNone
For R = 6 To UR
For CC = 1 To 10
RRP = CC * 5 + 2
RRuota = RRP - 4
If RRuota = 2 Then RRuota = 3
TR = 0
For CA = RRuota To RRuota + 3
A = Format(Cells(R, CA).Value, "00")
For CB = CA + 1 To RRuota + 4
B = Format(Cells(R, CB).Value, "00")
Ambo = Val(A & B)
If A > B Then Ambo = Val(B & A)
TR = 0
For Col1 = RRuota + 5 To RRuota + 8
P = P + 1
aa = Format(Cells(R, Col1).Value, "00")
For Col = Col1 + 1 To RRuota + 9
bb = Format(Cells(R, Col).Value, "00")
AmboE = Val(aa & bb)
If aa > bb Then AmboE = Val(bb & aa)
If AmboE = Ambo Then
Colore = 6
If TRR = 2 Then Colore = 4
Cells(R, Col).Interior.ColorIndex = Colore
Cells(R, Col1).Interior.ColorIndex = Colore
Cells(R, CA).Interior.ColorIndex = 45
Cells(R, CB).Interior.ColorIndex = 45
End If
Next Col
Next Col1
Next CB
Next CA
Next CC
Next R
End Sub
Sub CercaAmboDiam()
Worksheets("Archivio").Select
UR = Worksheets("Archivio").Range("C" & Rows.Count).End(xlUp).Row
Range("C5:BE" & UR).Interior.ColorIndex = xlNone
For R = 6 To UR
For CC = 1 To 5
RRP = CC * 5 + 2
RRuota = RRP - 4
TR = 0
For CA = RRuota To RRuota + 3
A = Format(Cells(R, CA).Value, "00")
For CB = CA + 1 To RRuota + 4
B = Format(Cells(R, CB).Value, "00")
Ambo = Val(A & B)
If A > B Then Ambo = Val(B & A)
For Col1 = RRuota + 25 To RRuota + 28
P = P + 1
aa = Format(Cells(R, Col1).Value, "00")
For Col = Col1 + 1 To RRuota + 29
bb = Format(Cells(R, Col).Value, "00")
AmboE = Val(aa & bb)
If aa > bb Then AmboE = Val(bb & aa)
If AmboE = Ambo Then
Colore = 6
If TRR = 2 Then Colore = 4
Cells(R, Col).Interior.ColorIndex = Colore
Cells(R, Col1).Interior.ColorIndex = Colore
Cells(R, CA).Interior.ColorIndex = 45
Cells(R, CB).Interior.ColorIndex = 45
End If
Next Col
Next Col1
Next CB
Next CA
Next CC
Next R
End Sub
Torna a Applicazioni Office Windows
TROVA e SOSTIUISCI solo si simboli operatori matematici Autore: papiriof |
Forum: Applicazioni Office Windows Risposte: 8 |
Trovare in che N° DI COLONNA si trova ... Autore: scanacc |
Forum: Applicazioni Office Windows Risposte: 4 |
Visitano il forum: Nessuno e 69 ospiti