Moderatori: Anthony47, Flash30005
Anthony47 ha scritto:Per favore dovresti usare gli allegati "a complemento" della descrizione, non "in sostituzione"; perche' come hai fatto quando l' immagine sara' non piu' disponibile questa discussione diventa illegibile, mentre l' obiettivo del forum e' anche creare un serbatoio di quesiti e (possibilmente) soluzioni che chiunque possa in futuro consultare.
Ciao.
Sub ColoraUguali()
Worksheets("Foglio1").Select
Columns("D:D").Interior.ColorIndex = xlNone
UR = Cells(Rows.Count, 1).End(xlUp).Row
For RR1 = 1 To UR - 1
N11 = Range("D" & RR1).Text
N12 = Mid(Range("D" & RR1).Text, 4, 2) & "." & Mid(Range("D" & RR1).Text, 1, 2)
Col = (Val(Mid(Range("D" & RR1).Text, 1, 2)) + Val(Mid(Range("D" & RR1).Text, 4, 2))) Mod 55 + 1
For RR2 = RR1 + 1 To UR
N2 = Range("D" & RR2).Text
If N11 = N2 Or N12 = N2 Then
Range("D" & RR1).Interior.ColorIndex = Col
Range("D" & RR2).Interior.ColorIndex = Col
End If
Next RR2
Next RR1
End Sub
...
Range("E" & RR1).Interior.ColorIndex = Col
Range("E" & RR2).Interior.ColorIndex = Col
...
...
Range("E" & RR1).value = "*"
Range("E" & RR2).value = "*"
...
3950 Spia Ba 78.60
3950 Spia Ba 78.58
3950 Spia Ba 68.22
3950 Spia Ba 68.58
3950 Spia Ba 22.78
3950 Spia Ba 60.58
3950 Spia Ba 22.60
3950 Spia Ba 68.78
3950 Spia Ba 22.58
3950 Spia Ba 68.60 * NO
3950 Spia Ca 04.66
3950 Spia Ca 71.04
3950 Spia Ca 18.04
3950 Spia Ca 18.71
3950 Spia Ca 18.05
3950 Spia Ca 71.66
3950 Spia Ca 05.66
3950 Spia Ca 18.66
3950 Spia Ca 04.05
3950 Spia Ca 71.05
3950 Spia Fi 10.71
3950 Spia Fi 71.28
3950 Spia Fi 10.28
3950 Spia Fi 72.71
3950 Spia Fi 72.28 * NO
3950 Spia Fi 40.10
3950 Spia Fi 10.72
3950 Spia Fi 40.28
3950 Spia Fi 40.72
3950 Spia Fi 40.71
3950 Spia Ge 17.54
3950 Spia Ge 17.52
3950 Spia Ge 54.52
3950 Spia Ge 03.52
3950 Spia Ge 16.52
3950 Spia Ge 03.54
3950 Spia Ge 16.03
3950 Spia Ge 17.03 * SI
3950 Spia Ge 17.16
3950 Spia Ge 16.54
3950 Spia Mi 82.84
3950 Spia Mi 79.23
3950 Spia Mi 84.90
3950 Spia Mi 79.84
3950 Spia Mi 79.82
3950 Spia Mi 84.23
3950 Spia Mi 23.90
3950 Spia Mi 82.90
3950 Spia Mi 82.23
3950 Spia Mi 79.90
3950 Spia Na 27.55
3950 Spia Na 27.02
3950 Spia Na 27.26
3950 Spia Na 27.11
3950 Spia Na 55.02
3950 Spia Na 55.26
3950 Spia Na 55.11
3950 Spia Na 02.26
3950 Spia Na 02.11
3950 Spia Na 26.11
3950 Spia Pa 63.68
3950 Spia Pa 63.45
3950 Spia Pa 63.37
3950 Spia Pa 63.38
3950 Spia Pa 68.45
3950 Spia Pa 68.37
3950 Spia Pa 68.38
3950 Spia Pa 45.37
3950 Spia Pa 45.38
3950 Spia Pa 37.38
3950 Spia Ro 05.64
3950 Spia Ro 05.24
3950 Spia Ro 05.51
3950 Spia Ro 05.12
3950 Spia Ro 64.24 * NO
3950 Spia Ro 64.51
3950 Spia Ro 64.12
3950 Spia Ro 24.51
3950 Spia Ro 24.12
3950 Spia Ro 51.12
3950 Spia To 35.01
3950 Spia To 35.03
3950 Spia To 35.41
3950 Spia To 35.17
3950 Spia To 01.03
3950 Spia To 01.41
3950 Spia To 01.17
3950 Spia To 03.41
3950 Spia To 03.17 * SI
3950 Spia To 41.17
3950 Spia Ve 16.24
3950 Spia Ve 16.88
3950 Spia Ve 16.90
3950 Spia Ve 16.77
3950 Spia Ve 24.88
3950 Spia Ve 24.90
3950 Spia Ve 24.77
3950 Spia Ve 88.90
3950 Spia Ve 88.77
3950 Spia Ve 90.77
-------------------------------------------------
3951 Spia Ba 60.77
3951 Spia Ba 60.43
3951 Spia Ba 77.72
3951 Spia Ba 60.72
3951 Spia Ba 28.72 * NO
3951 Spia Ba 72.43
3951 Spia Ba 77.43
3951 Spia Ba 28.43
3951 Spia Ba 77.28
3951 Spia Ba 60.28
3951 Spia Ca 72.36
3951 Spia Ca 80.50
3951 Spia Ca 50.36
3951 Spia Ca 16.50
3951 Spia Ca 80.72
3951 Spia Ca 80.16
3951 Spia Ca 80.36
3951 Spia Ca 72.50
3951 Spia Ca 16.72
3951 Spia Ca 16.36
3951 Spia Fi 60.06
3951 Spia Fi 06.29
3951 Spia Fi 06.63
3951 Spia Fi 63.29
3951 Spia Fi 15.63
3951 Spia Fi 15.06
3951 Spia Fi 60.29
3951 Spia Fi 60.63 * SI
3951 Spia Fi 15.29
3951 Spia Fi 60.15
3951 Spia Ge 63.13
3951 Spia Ge 34.13
3951 Spia Ge 34.63 * SI
3951 Spia Ge 60.13
3951 Spia Ge 34.59 * SI
3951 Spia Ge 59.13 *
3951 Spia Ge 59.63
3951 Spia Ge 34.60 * SI
3951 Spia Ge 60.63 * SI
3951 Spia Ge 60.59 * SI
3951 Spia Mi 20.08
3951 Spia Mi 20.59
3951 Spia Mi 87.20
3951 Spia Mi 08.59
3951 Spia Mi 87.08
3951 Spia Mi 87.13
3951 Spia Mi 13.59 * SI
3951 Spia Mi 13.08
3951 Spia Mi 13.20
3951 Spia Mi 87.59
3951 Spia Na 24.52
3951 Spia Na 24.35
3951 Spia Na 24.64 * NO
3951 Spia Na 24.33
3951 Spia Na 52.35
3951 Spia Na 52.64
3951 Spia Na 52.33
3951 Spia Na 35.64
3951 Spia Na 35.33
3951 Spia Na 64.33
3951 Spia Pa 34.60 * SI
3951 Spia Pa 34.40
3951 Spia Pa 34.68
3951 Spia Pa 34.59 * SI
3951 Spia Pa 60.40
3951 Spia Pa 60.68 *
3951 Spia Pa 60.59 * SI
3951 Spia Pa 40.68
3951 Spia Pa 40.59
3951 Spia Pa 68.59
3951 Spia Ro 42.08
3951 Spia Ro 42.19
3951 Spia Ro 42.83
3951 Spia Ro 42.75
3951 Spia Ro 08.19
3951 Spia Ro 08.83
3951 Spia Ro 08.75
3951 Spia Ro 19.83
3951 Spia Ro 19.75
3951 Spia Ro 83.75
3951 Spia To 73.49
3951 Spia To 73.21
3951 Spia To 73.16
3951 Spia To 73.20
3951 Spia To 49.21
3951 Spia To 49.16
3951 Spia To 49.20
3951 Spia To 21.16
3951 Spia To 21.20
3951 Spia To 16.20
3951 Spia Ve 36.20
3951 Spia Ve 36.63
3951 Spia Ve 36.56
3951 Spia Ve 36.34
3951 Spia Ve 20.63
3951 Spia Ve 20.56
3951 Spia Ve 20.34
3951 Spia Ve 63.56
3951 Spia Ve 63.34 * SI
3951 Spia Ve 56.34
Sub ColoraUguali()
Worksheets("Foglio2").Select
Columns("D:D").Interior.ColorIndex = xlNone
UR = Cells(Rows.Count, 1).End(xlUp).Row
For RR1 = 1 To UR - 1
N11 = Range("D" & RR1).Text
N12 = Mid(Range("D" & RR1).Text, 4, 2) & "." & Mid(Range("D" & RR1).Text, 1, 2)
Col = (Val(Mid(Range("D" & RR1).Text, 1, 2)) + Val(Mid(Range("D" & RR1).Text, 4, 2))) Mod 55 + 1
For RR2 = RR1 + 1 To UR
N2 = Range("D" & RR2).Text
If Range("A" & RR1).Value = Range("A" & RR2).Value And Range("C" & RR1).Value <> Range("C" & RR2).Value Then '<<<<<<< riga aggiunta per controllo valori
If N11 = N2 Or N12 = N2 Then
Range("D" & RR1).Interior.ColorIndex = Col
Range("D" & RR2).Interior.ColorIndex = Col
End If
End If '<<<<< riga aggiunta termine condizione
Next RR2
Next RR1
End Sub
Sub ColoraUguali()
Worksheets("Foglio2").Select
Columns("D:D").Interior.ColorIndex = xlNone
UR = Cells(Rows.Count, 1).End(xlUp).Row
For RR1 = 1 To UR - 1
N11 = Range("D" & RR1).Text
N12 = Mid(Range("D" & RR1).Text, 4, 2) & "." & Mid(Range("D" & RR1).Text, 1, 2)
Col = (Val(Mid(Range("D" & RR1).Text, 1, 2)) + Val(Mid(Range("D" & RR1).Text, 4, 2))) Mod 55 + 1
For RR2 = RR1 + 1 To UR
N2 = Range("D" & RR2).Text
If Range("A" & RR1).Value = Range("A" & RR2).Value And Range("C" & RR1).Value <> Range("C" & RR2).Value Then '<<<<<<< riga aggiunta per controllo valori
If N11 = N2 Or N12 = N2 Then
Range("E" & RR1).Value = "*" 'Range("D" & RR1).Interior.ColorIndex = Col
Range("E" & RR2).Value = "*" 'Range("D" & RR2).Interior.ColorIndex = Col
End If
End If '<<<<< riga aggiunta termine condizione
Next RR2
Next RR1
End Sub
Sub ColoraUguali() '<<<< nome macro
Application.ScreenUpdating = False
Application.Calculation = xlManual
Worksheets("Foglio2").Select '<<<<<< ATTENZIONE a questa riga esistente: controlla che il nome del foglio corrisponde al tuo
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Sub ColoraUguali()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Worksheets("Foglio2").Select
Columns("D:D").Interior.ColorIndex = xlNone
UR = Cells(Rows.Count, 1).End(xlUp).Row
For RR1 = 1 To UR - 1
N11 = Range("D" & RR1).Text
N12 = Mid(Range("D" & RR1).Text, 4, 2) & "." & Mid(Range("D" & RR1).Text, 1, 2)
Col = (Val(Mid(Range("D" & RR1).Text, 1, 2)) + Val(Mid(Range("D" & RR1).Text, 4, 2))) Mod 55 + 1
For RR2 = RR1 + 1 To UR
N2 = Range("D" & RR2).Text
If Range("A" & RR1).Value = Range("A" & RR2).Value And Range("C" & RR1).Value <> Range("C" & RR2).Value Then '<<<<<<< riga aggiunta per controllo valori
If N11 = N2 Or N12 = N2 Then
Range("E" & RR1).Value = "*" 'Range("D" & RR1).Interior.ColorIndex = Col
Range("E" & RR2).Value = "*" 'Range("D" & RR2).Interior.ColorIndex = Col
End If
End If '<<<<< riga aggiunta termine condizione
Next RR2
Next RR1
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Option Base 1
Option Explicit
Sub Spera2()
Dim MatrBck
Dim NumABI
Dim NumABK
Dim LRCod As Long, UBCod As Long
Dim Debg As Boolean
Dim I As Long, JJ As Long, CJJ As Long, KC As Integer, KK As Long
Dim CEstr As Long
'Debg = True '<<<< Userebbe M1:M5 per timer
Sheets("Foglio2").Select '<<< ADATTARE
If Debg Then Range("M1:M20").ClearContents
If Debg Then [M1] = Timer
Columns("D:D").Interior.ColorIndex = xlNone
LRCod = Cells(Rows.Count, 1).End(xlUp).Row
'
MatrBck = Range("D1:D" & LRCod)
UBCod = UBound(MatrBck, 1)
'
JJ = 1
Do
CEstr = Cells(JJ, 1)
KC = 4
CJJ = Application.WorksheetFunction.CountIf(Range("A1:A" & LRCod), CEstr)
For I = JJ To JJ - 1 + CJJ
NumABI = Split(MatrBck(I, 1), ".")
For KK = I + 1 To JJ - 1 + CJJ
NumABK = Split(MatrBck(KK, 1), ".")
If NumABI(0) = NumABK(0) And NumABI(1) = NumABK(1) Then
Cells(I, 4).Interior.ColorIndex = KC
Cells(KK, 4).Interior.ColorIndex = KC
KC = KC + 1
Else
If NumABI(0) = NumABK(1) And NumABI(1) = NumABK(0) Then
Cells(I, 4).Interior.ColorIndex = KC
Cells(KK, 4).Interior.ColorIndex = KC
KC = KC + 1
End If
End If
Next KK
Next I
JJ = JJ + CJJ
If JJ >= LRCod Then Exit Do
Loop
If Debg Then [M2] = Timer
End Sub
Torna a Applicazioni Office Windows
Macro che scatta quando cambia dato in un altro file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 14 |
Modidica Formula Somma I Riferimenti Autore: Francesco6918 |
Forum: Applicazioni Office Windows Risposte: 2 |
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 102 ospiti