trova ambi con condizioni

[Flash30005]

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

[miko]

buongiorno,
chiedo scusa per la divagazione non inerente agli argomenti di questo forum;
ma dopo una inutile ricerca sul web, pensando una certa attinenza tra macro e spiegazione,
speravo in un chiarimento nel forum.
tornando all'argomento di questo topic, non riesco ancora a risolvere il problema che
accennavo al punto 1) nel mio post del 20/03/13 e che riporto:

..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.

ho provato ad inserire condizioni del tipo:
if CC>=7 then TRR=1 and ColIn = 5 + RRuota
ma si ha una ripetizione dello stesso ciclo più volte.
saluti e grazie

[Flash30005]

Quello dipende dal fatto che per processare le ruote consecutive devi scansionare le 9 ruote (+1)
mentre per le diametrali ne occorrono solo 5
pertanto, visto che hai chiesto macro separate, le ho modificate per far far assolvere ad ognuna un compito preciso

Codice: Seleziona tutto

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


Codice: Seleziona tutto

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


Ciao

[miko]

buon sabato sera a tutti;
grazie, flash, per aver contribuito a risolvere i problemi relativi ai quesiti di questo topic.
ciao