Avatar billede CHC Forsker
27. december 2020 - 13:01 Der 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).

Vh CHO
Avatar billede Bjarne Juniormester
27. december 2020 - 14:48 #1
Hej CHC

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.
Avatar billede jens48 Ekspert
27. december 2020 - 20:16 #2
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
Avatar billede store-morten Ekspert
27. december 2020 - 21:52 #3
Prøv:
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
Avatar billede CHC Forsker
28. december 2020 - 07:19 #4
Hej

Tusind tak for hjælpen.

#2: Kan man lave en undtagelse, så ark 1 og 2 ikke tages med i makroen, da det er dataark, som ikke umiddelbart skal farves?

#3: Jeg får en "Compile error: Variable not defined" i 2. linje (For Each Sh In ActiveWorkbook.Sheets), hvor "Sh" bliver markeret.

Vh CHO
Avatar billede store-morten Ekspert
28. december 2020 - 07:54 #5
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
Avatar billede store-morten Ekspert
28. december 2020 - 08:03 #6
Springer Ark1 og Ark2 over:
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
       
Fortsæt:
    Next Sh
    Sheets(1).Select
End Sub
Avatar billede jens48 Ekspert
28. december 2020 - 15:24 #7
Nu med undtagelse af Ark1 og Ark2

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
Avatar billede CHC Forsker
28. december 2020 - 21:13 #8
Hej store-morten og jens48

Af hjertet tusind tak - I er bad-ass VBA-programmører.

/CHO
Avatar billede store-morten Ekspert
28. december 2020 - 21:17 #9
Velbekomme 🎅
Avatar billede Ny bruger Nybegynder

Din løsning...

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.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester