Farbformate erhalten

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Range("A1:F6"), Target) Is Nothing Then Range("A1:F6").Interior.ColorIndex = xlNone Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.ColorIndex = 6 End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rainer,
null Problemo:

    Static Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim intArray(1 To 6, 1 To 6) As Integer
    Dim lngColumn As Long, lngRow As Long
    Dim blnReset As Boolean
    If Not Intersect(Range("A1:F6"), Target) Is Nothing Then
        If intArray(1, 1) = 0 Then
            For lngColumn = 1 To 6
                For lngRow = 1 To 6
                    intArray(lngColumn, lngRow) = Cells(lngRow, lngColumn).Interior.ColorIndex
                Next
            Next
        End If
        Range("A1:F6").Interior.ColorIndex = xlNone
        Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.ColorIndex = 6
        blnReset = True
    Else
        If blnReset Then
            For lngColumn = 1 To 6
                For lngRow = 1 To 6
                    Cells(lngRow, lngColumn).Interior.ColorIndex = intArray(lngColumn, lngRow)
                Next
            Next
            blnReset = False
        End If
    End If
End Sub

Gruß
Nepumuk

Hallo Nepumuk, danke, wußte gar nicht dass blnReset auch erhalten böleibt wenn man die ganze Sub auf Static setzt, bz. dass das überhaupt so geht da kann ich mir ja Public Variablen im Modul sparen *freu*. Leider ist noch ein Fehler im Code. Innerhalb A1:F6 funtioniert er nicht korrekt, d.h. vorhanden Farben verschwinden, sie kmmen erst wieder wenn man außerhalb des Bereichs ist. Gruß Reinhard

Hi Rainer,
in Modul1:

Option Explicit
Public Zelle As Range, Farbe As Integer

in Diesearbeitsmappe:

Option Explicit
Private Sub Workbook_Open()
Set Zelle = Range("A1")
Farbe = Range("A1").Interior.ColorIndex
End Sub

in Tabelle1:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Range("A1:F6"), Target) Is Nothing Then Exit Sub
Range(Zelle, Zelle.Offset(0, 3)).Interior.ColorIndex = Farbe
Farbe = Cells(Target.Row, 1).Interior.ColorIndex
Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Interior.ColorIndex = 6
Set Zelle = Cells(Target.Row, 1)
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread