Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve felice che il risultato sia quanto ti aspettassi. Ps. Grazioso il tuo amico a 4 zampe. Si direbbe di razza Pinscher se non fosse per il mantello della schiena. la mia dell'avatar, oramai è un po' cresciuta, spinoncina meticcia che divide pari affetto con la sua sorella cockerina.  saluti Giap
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Uh! Bellissimi....... e scommetto anche molto intelligenti (lo si vede benissimo dal loro sguardo attento ed espressivo). Al cane manca solo la parola, ma penso che non gli serva affatto... dato che si fa capire benissimo anche in ragionamenti assai complessi... il mio è un meticcio (padre pincher puro, madre meticcia pincher/ chiwawa anche lei col pelo lungo sulla schiena). E' di un' intelligenza inaudita... Ciao e Grazie ancora. eZio.
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve prova con questa modifica e vedi il risultato. Code:
Sub EVIDENZIA()
Application.ScreenUpdating = False
With Range("b2:CN1000").Borders
.LineStyle = xlNone
End With
Uriga = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For n = 2 To Uriga
myvalue = Cells(n, 2).Value
aaa = Left(myvalue, InStr(1, myvalue, "'") - 1)
bbb = Mid(myvalue, InStr(1, myvalue, "'") + 1, 3)
If Len(bbb) = 2 Then bbb = 0 & bbb
Cells(n, 100).Value = CLng(aaa & bbb)
Next n
For A = 2 To Uriga
Prn = Cells(A, 100).Value
Prs = Cells(A + 1, 100).Value
Cells(A, 101).Value = Abs(Prn - Prs)
If Cells(A, 101).Value <= 10 Then
Cells(A, 102).Value = "x"
Cells(A + 1, 102).Value = "x"
Else
If Cells(A, 102) <> "" Then
Cells(A, 102).Value = "Z"
End If
End If
Next A
For I = 2 To Uriga
If Cells(I, 102).Value = "x" Then
nr = Cells(I, 102).Row
cnt = cnt + 1
ctrl = True
Else
If ctrl Then
If Cells(I, 102).Value = "Z" Then
nr = nr + 1
cnt = cnt + 1
End If
Range(Cells(nr - cnt + 1, 2), Cells(nr, 92)).Select
Selection.Borders.Weight = xlMedium
Selection.Borders.LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
col = 3
Select Case cnt
Case 2
TP = 1
Case 3
TP = Int(cnt / 2) + 1
Case 5, 7, 9, 11, 13, 15, 17
TP = Int(cnt / 2) + 2
Case 4, 6, 8, 10, 12, 14, 16, 18, 20
TP = cnt / 2
End Select
For CC = 1 To TP
Range(Cells(nr - cnt + CC, col), Cells(nr - cnt + CC + 1, col)).Interior.ColorIndex = 3 + CC
col = col + 1
Next CC
Range(Cells(nr - cnt + 1, 102), Cells(nr, 102)).ClearContents
cnt = 0
nr = 0
ctrl = False
Ctrl2 = False
End If
End If
Next
Columns("CV:CW").ClearContents
Range("a1").Select
Application.ScreenUpdating = True
End Sub
saluti Giap
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Mamma mia... lavoro da pelle d'oca, lo dico seriamente. ho aggiornato il FILE con: Foglio1 la situazione ideale, a seconda dei codici che all'interno di una bordatura differiscono di <=10 Foglio 2 il risultato del lavoro della macro con le note, che evidenziano le differenze rispetto al Foglio1 Foglio 3 un altro esempio in cui si vede il lavoro della macro e più a destra la situazione corretta Vorrei tanto poterti essere utile allo 0,001% (per me sarebbe già un bel traguardo...) :)) Ciao e Grazie per tutto... eZio
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve vedi il file allegato se soddisfa le esigenze. Il fileCi potrebbero essere delle piccole imperfezioni che forse e preferibile aggiustarle a mano a meno che non si vogliano fare (speriamo di no) dei lunghi cicli di comparazione riga per riga. saluti Giap
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
Provato: direi che è PERFETTO!!. Concordo pienamente nell'aggiustare manualmente le imperfezioni...
Ciao e Grazie infinite... anche per l'immensa pazienza nell'assecondarmi ;))))))
eZio
|