Markierte Zellen & Ergebnisse anzeigen

[PetrolMaxxe]

anbei die Fehlerbehandlung.

Gruß Uwe

[Solevita]

Hallo Uwe,

unglaublich, ich weiß gar nicht wie ich dir danken soll. Das war für mich eine scheinbar unlösbare Aufgabe und du hast sie mit einer Selbstverständlichkeit gelöst, die mich staunen lässt. Vielen Dank

[PetrolMaxxe]

Hallo,

bei mir funktioniert bedingte Formatierung von mehreren Werten so:

Code:

=ODER($E23="15+50"; $E23="55+100")

also wie bei normalen Formeln mit Semikolon. In doppelte Hochkommata ist richtig um zu verhindern dass eine Rechenoperation behandelt wird.
Du brauchst an dieser Stelle die Prozedur nicht rausnehmen. Du trägst die Formel für die bedingte Formatierung in Zelle E30 ein (Bezug auf $E30 beachten) und erweiterst den bed. Formatierungsbereich bis E23. Das hatte ich schon geahnt, das sowas noch erforderlich sein könnte.

Was die Mitnahme der Formatierung aus Strg./T Tabelle anlangt, muss das dann ohne Array ausgeführt werden (Zelle zu Zelle).
das wäre dann so zu ändern:

Code:

'*****************************************************************************
   
    If Not Intersect(Target, Range("rng_3")) Is Nothing Then
        Dim k&
        Set rngAdr = Tabelle2.Columns(1).Find(Target.Cells.Address)
        If Not rngAdr Is Nothing Then
            With Tabelle2.ListObjects(1).DataBodyRange
                j = rngAdr.Row + 1 - .Row
                Application.EnableEvents = False
                For i = 2 To 13
                    If i < 8 Then
                        Tabelle1.Cells(21 + i, 12) = .Cells(j, i)
                        If .Cells(j, i).Font.Bold = True Then
                            Tabelle1.Cells(21 + i, 12).Font.Bold = True
                        Else
                            Tabelle1.Cells(21 + i, 12).Font.Bold = False
                        End If
                    Else
                        Tabelle1.Cells(15 + i, 15) = .Cells(j, i)
                        If .Cells(j, i).Font.Bold = True Then
                            Tabelle1.Cells(15 + i, 15).Font.Bold = True
                        Else
                            Tabelle1.Cells(15 + i, 15).Font.Bold = False
                        End If
                    End If
                Next i
                Application.EnableEvents = True
            End With
        End If
    End If
'*****************************************************************************

Gruß Uwe

[Solevita]

So einfach wäre es gewesen. ";" statt ",". Danke, damit sind beide Fragen beantwortet.

Besteht die Möglichkeit einen Schreibschutz für die Zellen zu erstellen ohne die VBA Funktionen zu beeinträchtigen? Mir geht's nur darum, dass man die Werte nicht aus Versehen umschreibt während man durch die Tabelle klickt. Wenn ich das Blatt normal schütze, kommen Fehlermeldungen sobald ich in die Tabelle klicke.

[PetrolMaxxe]

ja, das geht problemlos.

An den erforderlichen Stellen im Modul der Tabelle1 Unprotect (entsperren) und Protect (sperren)
Außerhalb dieses Moduls Tabelle1.Unprotect und Tabelle1.Protect
Was in diesem Zusammenhang wichtig/sinnvoll ist, dass nach dem Sperren nur die Zellen/Zellbereiche freigegeben werden, welche noch ansteuerbar sein müssen.
Im rng_3 muss man dies mit einer Variable laden --> vergleichen der Variable mit Target.Cells --> unf ggf. die Variable in Target.Cells zurückschreiben.  Das verhindert auch da unbeasichtigte Eingriffe.
Die Variable mus im Sub Worksheet_SelectionChange geladen werden. 
Ich hoffe, du kommst mit diesen Infos zurecht.

Gruß Uwe

[Solevita]

Hallo Uwe,

ich setzte also beispielsweise folgenden Code unter Worksheet_SelectionChange? 

Code:

Me.Unprotect
    If Not Intersect(Target, Me.Range("B23")) Is Nothing Then
        Me.Cells(Target.Row, Target.Column).Select
    End If
    Me.Protect

Wenn ich das tue, wird zwar gesperrt, die Fehlermeldungen bleiben aber beim klicken in die Tabelle bestehen.

[PetrolMaxxe]

Hallo Arwed,
 
anbei mal den Einbau deiner restlichen Dinge. Ich habe auch gleich im rng_3 das versehentliche Ändern beim drin rumklicken blockiert.
Wenn dann tatsächlich mal was geändert werden soll, musst du dafür das zurückschreiben temporär auskommentieren.
 
Gruß Uwe

[Solevita]

Danke für die Anpassungen. Ich würde gern nur die Sperre für die obere Tabelle einfügen also rng_1 & rng_2 so wie es in deiner Beispieltabelle funktioniert. Es muss mir möglich sein in die kleine Tabelle unten rechts rein zukommen um die Ergebnisse mit Strg+C kopieren zu können. Der Cursor muss auch nicht von überall zurück auf B23 springen, mir war nur wichtig das er nach der Eingabe in B23 bleibt, bzw. wieder dahin zurück springt, was gut funktionierte.

Die Befehle "protect" und "unprotect" an den selben stellen wie bei dir im Code funktionieren bei mir leider nicht ohne Fehler. Gibt es eine Möglichkeit sie in diesem Code zu implementieren ohne die Funktionen zu verändern/beeinträchtigen?

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B24")) Is Nothing Then
        Application.EnableEvents = False
        Me.Cells(Target.Row - 1, Target.Column).Select
        Application.EnableEvents = True
    End If
    Dim iZeile As Range, iSpalte As Range, i&
    Dim rngAdr As Range, j&, arr1(1 To 6, 1 To 1), arr2(1 To 6, 1 To 1)
    If Not Intersect(Target, Range("rng_1")) Is Nothing Then
        Rows(2).Interior.Color = xlNone
        Columns(1).Interior.Color = xlNone
        Cells(2, Target.Column).Interior.Color = vbYellow
        Cells(Target.Row, 1).Interior.Color = vbYellow
    End If
    If Not Intersect(Target, Range("rng_2")) Is Nothing Then
        Rows(2).Interior.Color = xlNone
        Columns(1).Interior.Color = xlNone
        Cells(2, Target.Column - 1).Interior.Color = vbYellow
        Cells(Target.Row, 1).Interior.Color = vbYellow
    End If
    If Not Intersect(Target, Range("E23:E29")) Is Nothing Then
        i = InStr(1, Target.Cells.Value2(1, 1), "/")
        Set iZeile = Columns(1).Find(Mid(Target.Cells.Value2(1, 1), i + 1, 3), lookat:=xlWhole)
        If Target.Cells.Value2(1, 1) <> "" Then
            If Target.Cells.Value2(1, 1) <> "-" And Target.Cells.Value2(1, 1) <> "" Then
                Set iSpalte = Rows(2).Find(Left(Target.Cells.Value2(1, 1), i - 1), lookat:=xlWhole)
                Cells(iZeile.Row, iSpalte.Column).Select
            End If
        End If
    End If
    If Not Intersect(Target, Range("G23:G29")) Is Nothing Then
        i = InStr(1, Target.Cells.Value2(1, 1), "/")
        Set iZeile = Columns(1).Find(Mid(Target.Cells.Value2(1, 1), i + 1, 3), lookat:=xlWhole)
        If Target.Cells.Value2(1, 1) <> "-" And Target.Cells.Value2(1, 1) <> "" Then
            Set iSpalte = Rows(2).Find(Left(Target.Cells.Value2(1, 1), i - 1), lookat:=xlWhole)
            Cells(iZeile.Row, iSpalte.Column + 1).Select
        End If
    End If
   
'*****************************************************************************
   
    If Not Intersect(Target, Range("rng_3")) Is Nothing Then
        Dim k&
        Set rngAdr = Tabelle2.Columns(1).Find(Target.Cells.Address)
        If Not rngAdr Is Nothing Then
            With Tabelle2.ListObjects(1).DataBodyRange
                j = rngAdr.Row + 1 - .Row
                arr1(1, 1) = .Cells(j, 2)
                arr1(2, 1) = .Cells(j, 3)
                arr1(3, 1) = .Cells(j, 4)
                arr1(4, 1) = .Cells(j, 5)
                arr1(5, 1) = .Cells(j, 6)
                arr1(6, 1) = .Cells(j, 7)
                arr2(1, 1) = .Cells(j, 8)
                arr2(2, 1) = .Cells(j, 9)
                arr2(3, 1) = .Cells(j, 10)
                arr2(4, 1) = .Cells(j, 11)
                arr2(5, 1) = .Cells(j, 12)
                arr2(6, 1) = .Cells(j, 13)
                Application.EnableEvents = False
                For i = 1 To 6
                    Cells(22 + i, 12) = arr1(i, 1)
                    Cells(22 + i, 15) = arr2(i, 1)
                Next i
                Application.EnableEvents = True
            End With
        End If
    End If
   
'*****************************************************************************
End Sub

[PetrolMaxxe]

Hallo Arwed,
 
das liegt nicht am Code, du musst nur den Schreibschutz mal rausnehmen --> dann den Zellbereich der Tabelle unten rechts, welcher mit Strg./C kopiert werden soll markieren --> Rechtklick Zellen formatieren --> Schutz beide Häkcken raus --> dann Blatt schützen --> Häkchen nur in "nicht gesperrte Zellen auswählen" setzen.
Lasse in der 1. Zeile der Module das Option Explicit stehen, damit werden Fehler besser identifiziert. Da Dimensionieren der Variablen immer am Anfang der Prozedur. Werden Variablen benötigt, welche im Modul wirken sollen, gehören diese unter Option Explicit
Sollen Variablen in sämtlichen Modulen erreichbar sein gehören diese unter Option Explicit in ein allgemeines Modul statt Dim dann Public.
 
Was die Fehler anlangt, kann ich ohne die Datei vor mir zu haben so nicht beurteilen. Die Datei, wie ich sie dir hochgeladen habe arbeitet ohne Fehlerausgaben.
 
Da bleibt nur der Weg den kompletten! Kladderadatsch (alle Prozeduren und Daten in reduziert auf das sinnvoll Erforderliche) anonymisiert noch mal hochzuladen.
Ich denke der Fehler entsteht an Stellen, die ich nicht kenne.

Gruß Uwe