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
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Macro per aprire file salvato su sharepoint Onedrive Autore: marcopont |
Forum: Applicazioni Office Windows Risposte: 2 |
Come interrompere macro sndPlaySound Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 11 ospiti