Office-Fragen.de

Seiten: 1 2 3 4

anbei die Fehlerbehandlung.

Gruß Uwe

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 Exclamation

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

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.

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

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.

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

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

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

Seiten: 1 2 3 4

PetrolMaxxe

Solevita

PetrolMaxxe

Solevita

PetrolMaxxe

Solevita

PetrolMaxxe

Solevita

PetrolMaxxe