27. december 2020 - 13:01Der er
6 kommentarer og 3 løsninger
Farv faner, hvis...
Hej
Jeg har en fil med antal ark svarende til uger på året. I disse ark registreres i rækker timer, opgave mv. brugt hos kunder, startende ved række 2, og i et varierende antal registreringer (rækker) fra uge til uge.
Kan der laves en formel eller VBA (som jeg ikke er 100 meter mester i) for hvert ark, som: farver fanen for det pågældende ark grøn, hvis der er data i kolonne A (undtaget celle A1, da det er overskrift) og samtidig data i samme rækker i kolonne K (undtaget celle K1, da det er overskrift). farver fanen for det pågældende ark rød, hvis der er data i kolonne A (undtaget celle A1, da det er overskrift) og ikke samtidig er data i samme rækker i kolonne K (undtaget celle K1, da det er overskrift).
Jeg håber, at det giver mening. Tanken er, at der i kolonne A skives en dato og i kolonne K sættes "x", når kunden er faktureret. Derved kan jeg nemt se om der via arkfarven er faktureret for alle registreringer i det pågældende ark (uge).
Umiddelbart burde du kunne bruge betinget formatering til dette. Hvis du sætter betingelsen til større end f.eks. 0, så farves felterne, ved indtastning at tal større end 0.
Når du har lavet den betinget formatering på et felt, kan du bruge formatpenselen til de resterende felter.
Hvis jeg har forstået dig ret er det fanebladet og ikke selve arket du ønsker farvet. Så kan noget i denne stil måske bruges:
Sub Farve() Dim Sh As Worksheet Dim Ac, Kc, AKmax, x As Integer Dim Farve, Adr, Name As String Name = ActiveSheet.Name Adr = ActiveCell.Address For Each Sh In ActiveWorkbook.Worksheets Sh.Activate Ac = WorksheetFunction.CountA(Range("A:A")) Kc = WorksheetFunction.CountA(Range("K:K")) AKmax = WorksheetFunction.Max(Ac, Kc) Farve = "Grøn" For x = 2 To AKmax If Cells(x, 1) = "" Or Cells(x, 11) = "" Then Farve = "Rød" End If Next If Farve = "Rød" Then With Sh.Tab .Color = 255 .TintAndShade = 0 End With Else With Sh.Tab .Color = 65280 .TintAndShade = 0 End With End If Next Worksheets(Name).Activate Range(Adr).Select End Sub
Sub FarvFaner() For Each Sh In ActiveWorkbook.Sheets Sh.Activate If WorksheetFunction.CountA(Range("A:A")) = _ WorksheetFunction.CountA(Range("K:K")) Then Sh.Tab.Color = 5287936 Else Sh.Tab.Color = 255 End If Next Sh Sheets(1).Select End Sub
Sub FarvFaner() Dim Sh As Worksheet For Each Sh In ActiveWorkbook.Sheets Sh.Activate If WorksheetFunction.CountA(Range("A:A")) = _ WorksheetFunction.CountA(Range("K:K")) Then Sh.Tab.Color = 5287936 Else Sh.Tab.Color = 255 End If Next Sh Sheets(1).Select End Sub
Sub FarvFaner() Dim Sh As Worksheet For Each Sh In ActiveWorkbook.Sheets Sh.Activate If ActiveSheet.Name = "Ark1" Or ActiveSheet.Name = "Ark2" Then GoTo Fortsæt
If WorksheetFunction.CountA(Range("A:A")) = _ WorksheetFunction.CountA(Range("K:K")) Then Sh.Tab.Color = 5287936 Else Sh.Tab.Color = 255 End If
Sub Farve() Dim Sh As Worksheet Dim Ac, Kc, AKmax, x As Integer Dim Farve, Adr, Name As String Name = ActiveSheet.Name Adr = ActiveCell.Address For Each Sh In ActiveWorkbook.Worksheets If Sh.Name = "Ark1" Or Sh.Name = "Ark2" Then GoTo A: Sh.Activate Ac = WorksheetFunction.CountA(Range("A:A")) Kc = WorksheetFunction.CountA(Range("K:K")) AKmax = WorksheetFunction.Max(Ac, Kc) Farve = "Grøn" For x = 2 To AKmax If Cells(x, 1) = "" Or Cells(x, 11) = "" Then Farve = "Rød" End If Next If Farve = "Rød" Then With Sh.Tab .Color = 255 .TintAndShade = 0 End With Else With Sh.Tab .Color = 65280 .TintAndShade = 0 End With End If A: Next Worksheets(Name).Activate Range(Adr).Select End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
