Avatar billede cjeskovby Nybegynder
04. april 2006 - 16:43 Der er 4 kommentarer og
2 løsninger

Farve en del af række betinget af hvilken status cellen har

Jeg ønsker at give en del af en række en bestemt farve efter hvad status en celle i samme område får.

Jeg kan ikke bruge Betinget Formatering, da jeg har mere en 3 muligheder.

Jeg har indtil videre lavet følgende, men det tager kun det enkelte felt og som sagt så ønsker jeg det ændre farven i felterne område A til I :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Long
Dim c As Range
Dim tmp() As Variant

  With Worksheets("Ny Opgave")
        With Target
            Select Case UCase(.Value)
                Case "NY"
                    .Interior.ColorIndex = 6
                Case "I GANG"
                    .Interior.ColorIndex = 43
                Case "OBSERVATION"
                    .Interior.ColorIndex = 8
                Case "SLUT"
                    .Interior.ColorIndex = 46
                Case "ARKIV"
                    .Interior.ColorIndex = 46
                Case Else
                    .Interior.ColorIndex = xlNone
            End Select
        End With
  End With
End Sub
Avatar billede excelent Ekspert
04. april 2006 - 17:39 #1
Ret Mappe11 og Ark3 og evt. område til aktuel

Sub farve()
Dim c
Application.ScreenUpdating = False
For Each c In Workbooks("Mappe11").Worksheets("Ark3").Range("A1:I50").Cells
c.Activate
If c.Value = "" Then c.Interior.ColorIndex = xlNone: GoTo ny
If c.Value = "NY" Then c.Interior.ColorIndex = 6: GoTo ny
If c.Value = "I GANG" Then c.Interior.ColorIndex = 43: GoTo ny
If c.Value = "OBSERVATION" Then c.Interior.ColorIndex = 8: GoTo ny
If c.Value = "SLUT" Then c.Interior.ColorIndex = 46: GoTo ny
If c.Value = "ARKIV" Then c.Interior.ColorIndex = 46: GoTo ny
c.Interior.ColorIndex = xlNone
ny:
Next
Application.ScreenUpdating = False
[a1].Activate
End Sub
Avatar billede cjeskovby Nybegynder
04. april 2006 - 17:43 #2
Har selv lige løst problemet på følgende måde :

If ActiveCell.Column = 3 Then
  With Worksheets("Ny Opgave")
        With Target
            Select Case UCase(.Value)
                Case "NY"
                    For Counter = 1 To 9
                    ActiveCell.EntireRow.Cells(1, Counter).Interior.ColorIndex = 6
                    Next Counter
                Case "I GANG"
                    For Counter = 1 To 9
                    ActiveCell.EntireRow.Cells(1, Counter).Interior.ColorIndex = 43
                    Next Counter
                Case "OBSERVATION"
                    For Counter = 1 To 9
                    ActiveCell.EntireRow.Cells(1, Counter).Interior.ColorIndex = 8
                    Next Counter
                Case "SLUT"
                    For Counter = 1 To 9
                    ActiveCell.EntireRow.Cells(1, Counter).Interior.ColorIndex = 46
                    Next Counter
                Case "ARKIV"
'                    A = ActiveCell.Interior.ColorIndex
'MsgBox A
                    For Counter = 1 To 9
                    ActiveCell.EntireRow.Cells(1, Counter).Interior.ColorIndex = 46
                    Next Counter
                Case Else
                    For Counter = 1 To 9
                    ActiveCell.EntireRow.Cells(1, Counter).Interior.ColorIndex = xlNone
                    Next Counter
            End Select
        End With
  End With
End If

End Sub

Ellers tak for hjælpen.
Avatar billede excelent Ekspert
04. april 2006 - 18:10 #3
no problemo, din kode er iøvrigt også pænere :-)
Avatar billede excelent Ekspert
08. april 2006 - 08:08 #4
husk at lukke spørgsmål
Avatar billede cjeskovby Nybegynder
08. april 2006 - 20:44 #5
luk
Avatar billede cjeskovby Nybegynder
08. april 2006 - 20:46 #6
luk
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
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

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