Moderatori: Anthony47, Flash30005
Sub Colora()
URD = Worksheets("Foglio1").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Foglio1").Range("C1:G" & URD).Interior.ColorIndex = xlNone
Area = "C1:G" & URD
For CC = 12 To 26
ValC = Cells(1, CC).Value
For Each ValCA In Worksheets("Foglio1").Range(Area)
If ValC = ValCA Then ValCA.Interior.ColorIndex = 6
Next
Next CC
End Sub
Avatar3 ha scritto:La macro in questo caso andrebbe modificata e adattata alla nuova esigenza
hai fatto un esempio di numeri con le decine quindi si presentano tutte a due cifre
ma nel caso di unità, cosa hai 1 o 01 ?
es: 72.12.42.01.31 oppure 72.12.42.1.31
inoltre la cella verrà colorata nel caso in cui esista il numero cercato indipendentemente dagli altri numeri che, occupando la stessa cella, avranno il fondo colorato.
Ciao
Sub Colora2()
Worksheets("Foglio2").Select
URC = Worksheets("Foglio2").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Foglio2").Range("C1:C" & URC).Interior.ColorIndex = xlNone
Dim VettV(5) As Integer
For CC = 12 To 26
ValC = Cells(1, CC).Value
For RR = 1 To URC
VettV(1) = Val(Mid(Range("C" & RR).Text, 1, 2))
VettV(2) = Val(Mid(Range("C" & RR).Text, 4, 2))
VettV(3) = Val(Mid(Range("C" & RR).Text, 7, 2))
VettV(4) = Val(Mid(Range("C" & RR).Text, 10, 2))
VettV(5) = Val(Mid(Range("C" & RR).Text, 13, 2))
If ValC = VettV(1) Or ValC = VettV(2) Or ValC = VettV(3) Or ValC = VettV(4) Or ValC = VettV(5) Then Range("C" & RR).Interior.ColorIndex = 6
Next RR
Next CC
End Sub
Sub Colora2()
Worksheets("Foglio2").Select
URC = Worksheets("Foglio2").Range("C" & Rows.Count).End(xlUp).Row
Worksheets("Foglio2").Range("C1:C" & URC).Interior.ColorIndex = xlNone
Worksheets("Foglio2").Range("G1:G" & URC).ClearContents
Dim VettV(5) As Integer
For RR = 1 To URC
Contatore = 0
VettV(1) = Val(Mid(Range("C" & RR).Text, 1, 2))
VettV(2) = Val(Mid(Range("C" & RR).Text, 4, 2))
VettV(3) = Val(Mid(Range("C" & RR).Text, 7, 2))
VettV(4) = Val(Mid(Range("C" & RR).Text, 10, 2))
VettV(5) = Val(Mid(Range("C" & RR).Text, 13, 2))
For CC = 12 To 26
ValC = Cells(1, CC).Value
If ValC = VettV(1) Then Contatore = Contatore + 1
If ValC = VettV(2) Then Contatore = Contatore + 1
If ValC = VettV(3) Then Contatore = Contatore + 1
If ValC = VettV(4) Then Contatore = Contatore + 1
If ValC = VettV(5) Then Contatore = Contatore + 1
If Contatore > 0 Then Range("C" & RR).Interior.ColorIndex = 6
Range("G" & RR).Value = Contatore
Next CC
Next RR
End Sub
Sub Colora3()
For I = 1 To 4
Sheets(I).Select
URC = Range("C" & Rows.Count).End(xlUp).Row
Range("C1:C" & URC).Interior.ColorIndex = xlNone
Range("G1:G" & URC).ClearContents
Dim VettV(5) As Integer
For RR = 1 To URC
Contatore = 0
VettV(1) = Val(Mid(Range("C" & RR).Text, 1, 2))
VettV(2) = Val(Mid(Range("C" & RR).Text, 4, 2))
VettV(3) = Val(Mid(Range("C" & RR).Text, 7, 2))
VettV(4) = Val(Mid(Range("C" & RR).Text, 10, 2))
VettV(5) = Val(Mid(Range("C" & RR).Text, 13, 2))
For CC = 12 To 26
ValC = Cells(1, CC).Value
For VV = 1 To 5
If ValC = VettV(VV) Then Contatore = Contatore + 1
Next VV
If Contatore > 0 Then Range("C" & RR).Interior.ColorIndex = 6
Range("G" & RR).Value = Contatore
Next CC
Next RR
Next I
End Sub
Sub Colora3()
For I = 1 To 4
Sheets(I).Select
URC = Range("C" & Rows.Count).End(xlUp).Row
Range("C1:C" & URC).Interior.ColorIndex = xlNone
Range("G1:G" & URC).ClearContents
Dim VettV(5) As Integer
For RR = 1 To URC
Contatore = 0
VettV(1) = Val(Mid(Range("C" & RR).Text, 1, 2))
VettV(2) = Val(Mid(Range("C" & RR).Text, 4, 2))
VettV(3) = Val(Mid(Range("C" & RR).Text, 7, 2))
VettV(4) = Val(Mid(Range("C" & RR).Text, 10, 2))
VettV(5) = Val(Mid(Range("C" & RR).Text, 13, 2))
For CC = 12 To 26
If Cells(1, CC).Value <> 0 Then
ValC = Cells(1, CC).Value
For VV = 1 To 5
If ValC = VettV(VV) Then Contatore = Contatore + 1
Next VV
If Contatore > 0 Then Range("C" & RR).Interior.ColorIndex = 6
Range("G" & RR).Value = Contatore
End If
Next CC
Next RR
Next I
End Sub
Torna a Applicazioni Office Windows
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 |
Problemi di stampa file .PDF da macro. Autore: zanatta77 |
Forum: Applicazioni Office Windows Risposte: 1 |
Visitano il forum: Nessuno e 57 ospiti