ciao a tutti.ho 12 fogli mensili per la turnazione mensile di 20 colleghi.
vorrei far si che determinate lettere si colorassero ; es, m verde,p salmone,n blu ecc. come posso fare?
Moderatori: Anthony47, Flash30005
Public Foglio As String
Sub ColoraCar()
Worksheets(Foglio).Select
Cells.Font.ColorIndex = xlAutomatic
Dim VettC(3) As String '<<<< dimensionare vettore per in numero delle lettere
VettC(1) = "m" '<<<<< assegnare al vettore la lettera
VettC(2) = "n"
VettC(3) = "p"
For NumCar = 1 To 3
Stc = VettC(NumCar)
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets(Foglio).Range("A1:A" & UR) '<<<< determinare l'area di ricerca
Set C = .Find(Stc, LookIn:=xlValues, LookAt:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
C.Select
Stringa = C.Value
For CarT = 1 To Len(Stringa)
CarC = Mid(Stringa, CarT, 1)
Select Case CarC
Case VettC(1)
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = 4
Case VettC(2)
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = 5
Case VettC(3)
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = 46
Case Else
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = xlAutomatic
End Select
Next CarT
Do
Set C = .FindNext(C)
If firstAddress = C.Address Then Exit Do
C.Select
Stringa = C.Value
For CarT = 1 To Len(Stringa)
CarC = Mid(Stringa, CarT, 1)
Select Case CarC
Case VettC(1)
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = 4
Case VettC(2)
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = 5
Case VettC(3)
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = 46
Case Else
ActiveCell.Characters(Start:=CarT, Length:=1).Font.ColorIndex = xlAutomatic
End Select
Next CarT
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
Next NumCar
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Activate()
Foglio = Name
Call ColoraCar
End Sub
UR = Range("A" & Rows.Count).End(xlUp).Row '<<<< qui metterai "B"
With Worksheets(Foglio).Range("A1:A" & UR) '<<<< determinare l'area di ricerca "B10:AF" lasciando la variabile UR nel caso che le righe fossero più di 42 vengono calcolate
Torna a Applicazioni Office Windows
Excel: formula per aggiungere una "S" alle lettere minuscole Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 3 |
Colorare una cella se cambia una data+orario Autore: Paolo67 |
Forum: Applicazioni Office Windows Risposte: 5 |
Visitano il forum: Nessuno e 65 ospiti