CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

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

Synes godt om

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.

Synes godt om

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

Synes godt om

1 synes godt om dette

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

Synes godt om

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

Synes godt om

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

Synes godt om

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

Synes godt om

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

Synes godt om

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

Synes godt om

store-morten Ekspert

28. december 2020 - 21:17 #9

Velbekomme 🎅

Synes godt om

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.

Følg dette spørgsmål

Opret Preview

Excel kurser

Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Automatisk give specifikke point udfra placering Af jernrosen3 i Excel	5	19/12/202410:24	I går 13:14
Delvis udfyld en celle, baseret på en %-sats fra anden celle Af Brian Nielsen i Excel	2	16/12/202415:27	17/12/202422:03
Hjælp til formatering af excel ark. Af Nicholas i Excel	23	13/12/202412:32	18/12/202415:44
To x-akser men kun ét datasæt? Af TheLibrarian i Excel	1	10/12/202409:17	10/12/202410:35
Isolere en dato i tekst/tal Af jernrosen3 i Excel	7	09/12/202408:59	09/12/202410:38

Se alle spørgsmål i kategorien Opret spørgsmål

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

Alle kategorier på Eksperten

Seneste artiklerRSS

08:58

Dropper med omgående virkning kæmpe-kontrakt på udvikling af Lotto-app til 100 millioner kroner

07:37

TikTok står over forbud i USA om få uger: Men nu vil Trump beholde TikTok - i hvert fald ‘i et stykke tid’

06:50

GlobalConnect-direktør Monika Juul Henriksen fratræder: Skal være topchef for et af Danmarks største webbureauer

06:00

Morgen-briefing: Fejl i næsten alle indberetninger for udlejning via digitale platforme / Nyt netværk på vej under Statens It-råd / Albanien forbyder TikTok i et år

20/12

Netværkstest: Første mesh-sæt med komplette WiFi 7-features sætter nye rekorder for dækning og hastighed

20/12

Omsætning er steget med 100 millioner kroner på to år: Microsoft danske udviklingscenter har udbetalt milliarder i udbytte

20/12

Nørgaard: Copilot scorer pænt højt i min kendte 3D-test (Dyrt, Dumt, Dårligt)

20/12

Amazon ramt af største strejke nogensinde: Ansatte gået hjem

20/12

CISO Sarah Aalborg forlader Tivoli: Her er hendes planer for fremtiden

20/12

Sådan vil Domstolsstyrelsen nedbringe legacy og teknisk gæld: Her er den nye plan

20/12

Temu åbner stort varehus i Sverige og kan nu sende varer til danskerne endnu hurtigere: "Hvad vi frygtede, er sket"

Vis flere artikler

IT-JOB

BEC

Data Analyst

Matas A/S

Technical Project Manager in Matas Group Digital

Digitaliseringsstyrelsen

Teknisk profil til at fremtidssikre Digital Post

Pharma Nord

PHP backend-udvikler

KMD A/S

IAM Process Owner

Vis flere jobs

Seneste spørgsmål Seneste aktivitet

21/1222:16	Er "OneDrive" et "Must" ? Koster det penge ? Af Ikke-ekspert i Windows
21/1216:42	Windows Media Player - Hvilken version (Versioner) er gode til at afspille og kopiere ? Af Ikke-ekspert i Musik & videoafspillere
21/1212:54	Fejlfinding: Årsag til blank skærm og ingen BIOS fra Lenovo 90BH Af Mads i PC
21/1209:42	Outlook - kan ikke kopiere opgaver Af barth i Office & Kontorpakker
21/1200:26	Genhøre telefonsamtale Af anonym24 i Chat & Messaging