Moderatori: Anthony47, Flash30005
Sub Evidenzia()
Dim Colore(30) As Integer
Dim ContaCol(30) As Integer
Colore(1) = 4
Colore(2) = 6
Colore(3) = 7
Colore(4) = 8
Colore(5) = 10
Colore(6) = 12
Colore(7) = 14
Colore(8) = 15
Colore(9) = 17
Colore(10) = 18
Colore(11) = 22
Colore(12) = 23
Colore(13) = 24
Colore(14) = 26
Colore(15) = 31
Colore(16) = 33
Colore(17) = 34
Colore(18) = 35
Colore(19) = 38
Colore(20) = 40
Colore(21) = 41
Colore(22) = 43
Colore(23) = 45
Colore(24) = 46
Colore(25) = 47
Colore(26) = 48
Colore(27) = 50
Colore(28) = 53
Colore(29) = 54
Colore(30) = 44
UC3 = Worksheets(Foglio).Cells(RigaT, Columns.Count).End(xlToLeft).Column
With Worksheets(Foglio).Range(Cells(RigaT, 5), Cells(RigaT + 1, UC3))
Set C = .Find(Val1, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Interior.ColorIndex = Colore(Val1)
ContaCol(Val1) = ContaCol(Val1) + 1
Set C = .FindNext(C)
On Error Resume Next
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
With Worksheets(Foglio).Range(Cells(RigaT, 5), Cells(RigaT + 1, UC3))
Set C = .Find(Val2, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Interior.ColorIndex = Colore(Val1)
ContaCol(Val1) = ContaCol(Val1) + 1
Set C = .FindNext(C)
On Error Resume Next
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
With Worksheets(Foglio).Range(Cells(RigaT, 5), Cells(RigaT + 1, UC3))
Set C = .Find(Val3, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Interior.ColorIndex = Colore(Val1)
ContaCol(Val1) = ContaCol(Val1) + 1
Set C = .FindNext(C)
On Error Resume Next
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
For CellaC = 1 To 30
Range("A" & CellaC + 4).Interior.ColorIndex = Colore(CellaC)
Range("A" & CellaC + 4).Value = Range("AQ" & CellaC + 4).Value + ContaCol(CellaC)
Next CellaC
End Sub
sangennarosan ha scritto:PS: Non li giocate perche' sto ancora sperimentando
PS2: Se poi escono mi mangio il prepuzio
Torna a Applicazioni Office Windows
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 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Macro che ricerca combinazioni che danno un valore Autore: kar64 |
Forum: Applicazioni Office Windows Risposte: 10 |
Excel 2016 - Funzione SCARTO + INDIRETTO Autore: pl1957 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 71 ospiti