Supportnet / Forum / Tabellenkalkulation

Sub Färben() Dim i As Integer Dim N As Integer ´Dim ZZelle As String ´Dim ZBereich As String Application.ScreenUpdating = False Range("C18:AG36").Select Selection.Interior.ColorIndex = xlNone Selection.Font.ColorIndex = 0 For i = 18 To 36 ´Zeile For N = 3 To 34 ´Reihe ´ZZelle = Cells(n, i) Cells(N, i).Select If Cells(i, N).Value = "F" Then Cells(i, N).Interior.ColorIndex = 36 If Cells(i, N).Value = "X" Then Cells(i, N).Interior.ColorIndex = 18 If Cells(i, N).Value = "U" Then Cells(i, N).Font.ColorIndex = 3 If Cells(i, N).Value = "ZF" Then Cells(i, N).Font.ColorIndex = 5 If Cells(i, N).Value = "K" Then Cells(i, N).Font.ColorIndex = 7 If Cells(i, N).Value = "A" Then Cells(i, N).Font.ColorIndex = 44 If Cells(i, N).Value = "Su" Then Cells(i, N).Font.ColorIndex = 45 If Cells(i, N).Value = "Ka" Then Cells(i, N).Font.ColorIndex = 50 If Cells(i, N).Value = "AF" Then Cells(i, N).Font.ColorIndex = 4 If Cells(i, N).Value = "S" Then Cells(i, N).Font.ColorIndex = 5 If Cells(i, N).Value = "S" Then Cells(i, N).Interior.ColorIndex = 43 If Cells(i, N).Value = "B" Then Cells(i, N).Font.ColorIndex = 10 If Cells(i, N).Value = "B" Then Cells(i, N).Interior.ColorIndex = 44 ActiveCell.Offset(0, 1).Activate Next N Next i Range("AJ8").Select Application.ScreenUpdating = True End Sub dieses Makro soll automatisch beim aufrufen der Datei starten und die ganze zeit aktiv bleiben solange die datei offen ist. Kann mir jemand helfen

Hi,

wenn ich dein Anliegen richtig verstanden habe, dann sollte dieser Code unter der Tabelle allein ausreichend sein

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C18:AG36")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then
        Selection.Interior.ColorIndex = xlNone
        Selection.Font.ColorIndex = xlAutomatic
        Exit Sub
    End If
    If Target = "F" Then
        Target.Interior.ColorIndex = 36
    ElseIf Target = "X" Then Target.Interior.ColorIndex = 18
    ElseIf Target = "U" Then Target.Font.ColorIndex = 3
    ElseIf Target = "ZF" Then Target.Font.ColorIndex = 5
    ElseIf Target = "K" Then Target.Font.ColorIndex = 7
    ElseIf Target = "A" Then Target.Font.ColorIndex = 44
    ElseIf Target = "Su" Then Target.Font.ColorIndex = 45
    ElseIf Target = "Ka" Then Target.Font.ColorIndex = 50
    ElseIf Target = "AF" Then Target.Font.ColorIndex = 4
    ElseIf Target = "S" Then Target.Font.ColorIndex = 5
    ElseIf Target = "S" Then Target.Interior.ColorIndex = 43
    ElseIf Target = "B" Then Target.Font.ColorIndex = 10
    ElseIf Target = "B" Then Target.Interior.ColorIndex = 44
    ElseIf Target <> "X" And Target <> "U" And Target <> "ZF" And Target <> "K" And _
        Target <> "A" And Target <> "Su" And Target <> "Ka" And Target <> "AF" And _
            Target <> "S" And Target <> "B" Then
                Target.Interior.ColorIndex = xlNone
                Target.Font.ColorIndex = xlAutomatic
    End If
End Sub

Bis später,
Karin

Hi, ich habe es erst mal bei diesem Makro belassen, es startet ja auch wenn ich die datei öffne, aber wenn ich die tabelle wechsele, dann sien die daten nicht im gewünschten Layout, dann muß i erst den button drücken.

Sub auto_open()


Dim i As Integer
Dim N As Integer

´Dim ZZelle As String
´Dim ZBereich As String
Application.ScreenUpdating = False
Range("D18:AH36").Select
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 0
For i = 18 To 36 ´Zeile
For N = 4 To 34 ´Reihe
´ZZelle = Cells(n, i)
Cells(N, i).Select

If Cells(i, N).Value = "F" Then Cells(i, N).Interior.ColorIndex = 36
If Cells(i, N).Value = "Ko" Then Cells(i, N).Font.ColorIndex = 4
If Cells(i, N).Value = "U" Then Cells(i, N).Font.ColorIndex = 3
If Cells(i, N).Value = "Ua" Then Cells(i, N).Font.ColorIndex = 50
If Cells(i, N).Value = "ZF" Then Cells(i, N).Font.ColorIndex = 5
If Cells(i, N).Value = "K" Then Cells(i, N).Font.ColorIndex = 7
If Cells(i, N).Value = "A" Then Cells(i, N).Font.ColorIndex = 44
If Cells(i, N).Value = "Su" Then Cells(i, N).Font.ColorIndex = 45
If Cells(i, N).Value = "SÜ" Then Cells(i, N).Font.ColorIndex = 30
If Cells(i, N).Value = "SÜ" Then Cells(i, N).Interior.ColorIndex = 4
If Cells(i, N).Value = "AF" Then Cells(i, N).Font.ColorIndex = 10
If Cells(i, N).Value = "S" Then Cells(i, N).Font.ColorIndex = 5
If Cells(i, N).Value = "S" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "B" Then Cells(i, N).Font.ColorIndex = 10
If Cells(i, N).Value = "B" Then Cells(i, N).Interior.ColorIndex = 44
If Cells(i, N).Value = "0" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "0" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "1" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "1" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "2" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "2" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "3" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "3" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "4" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "4" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "5" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "5" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "6" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "6" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "7" Then Cells(i, N).Font.ColorIndex = 6
If Cells(i, N).Value = "7" Then Cells(i, N).Interior.ColorIndex = 3
If Cells(i, N).Value = "8" Then Cells(i, N).Font.ColorIndex = 1
If Cells(i, N).Value = "9" Then Cells(i, N).Font.ColorIndex = 50
If Cells(i, N).Value = "9" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "10" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "10" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "11" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "11" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "12" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "12" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "13" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "13" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "14" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "14" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "15" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "15" Then Cells(i, N).Interior.ColorIndex = 43
If Cells(i, N).Value = "16" Then Cells(i, N).Font.ColorIndex = 26
If Cells(i, N).Value = "16" Then Cells(i, N).Interior.ColorIndex = 43
ActiveCell.Offset(0, 1).Activate
Next N
Next i
Range("AK8").Select
Application.ScreenUpdating = True
End Sub

• Makro automatisch aktualisieren
• Makro automatisch ausführen
• Makro automatisch starten