Zellen Sperren wenn Eingabe in übergeordnete Zeile

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' Row before target.row must already be filled (i.e. Row 1 contains initial start) ' the level (column) clicked is increased be 1 ' if precedessor and descent Const dStart = 0 ' Start first level (e.g. 0 or 1) Const dMaxCol = 5 ' depth of level Dim lCol As Long, lxCol As Long, lRow As Long If Target.Row = 1 Or Target.Column > dMaxCol Or Target.Count > 1 Then Exit Sub If IsEmpty(Target.Offset(-1, 0).Value) Then Exit Sub Application.EnableEvents = False If IsEmpty(Me.Cells(Target.Row, dMaxCol).Value) Or _ Me.Cells(Target.Row, dMaxCol).Value >= Me.Cells(Target.Row + 1, dMaxCol).Value Then lCol = Target.Column If IsEmpty(Target.Value) Then Target.EntireRow.Insert (xlShiftDown) lRow = Target.Row - 1 Else Target.Offset(1, 0).EntireRow.Insert (xlShiftDown) lRow = Target.Row + 1 If Target.Column lxCol Me.Cells(lRow, lxCol).Value = Me.Cells(lRow - 1, lxCol).Value End Select Next lxCol Cancel = True Else MsgBox "Impossible to insert level!", vbOKOnly + vbExclamation, "Insert Level" End If Application.EnableEvents = True End Sub

Hallo Renée,
vielen Dank, dass Du Dich meinem Anliegen angenommen hast.
Ich habe den Code mal in die Mappe bzw. in das Sheet (Tabelle 1) eingefügt, obwohl ich diesen absolut nicht verstehe. Ich komme normalerweise mit Standard VBA Code gut hin und verstehe diesen auch meist beim Lesen. Hier absolute Fehlanzeige! :-(
Vielleicht kannst Du mir den VBA Code kurz erläutern.
Ich habe eine neue Beispielmappe angelegt, die vielleicht besser erklärt aus welchen Reihen/Zeilen sich die oberste Struktur zusammensetzt und wie dabei die Katalog-Struktur vorne sich verändert. Die Katalog-Struktur gibt nämlich die Änderung des Additionsverfahrens bzw. des Additionsbereiches vor.
Das Sperren der drunterliegenden Katalogstrukturen wäre eigentlich ja die Lösung. Wobei die Zeilen sich nicht aus der Anordnung in der Tabelle ergeben, sondern aus der Zahlenkombination. Da es sein kann, dass z.B. die 5. und 6. Zeile in das Additionsverfahren nicht mit einfließen, die 7. und 8. Zelle allerdings schon, da die Zahlenkombination dementsprechend ist. Weiß nicht, ob ich das richtig erläutert habe.
Ach ich weiß irgendwie gar nichts, ...ob das überhaupt geht was ich vor habe. Ich habe schon ein, zwei nützliche Excel-Tabellen mittels VBA aufgepeppt. Hier geht es um Arbeitserleichterung die mir wöchentlich ca. 5-8 Stunden einbringen würde. Aber irgendwie kann ich mit komplexen Schleifen bzw. "schweren" VBA Codes nichts anfangen.
sonnige Grüße
Jessi

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' Code for a simple decimal classification ' Row before target.row must already be filled (i.e. Row 1 contains initial start) ' the level below the one clicked is increased be 1 ' clicking a empty cell below one of highest level increases highest level Const dStart = 0 ' Start first level (e.g. 0 or 1) Const dMinCol = 6 ' min Column Const dMaxCol = 10 ' max Column Dim lCol As Long, lxCol As Long, lRow As Long If Target.Row = 1 Or Target.Count > 1 Or _ Target.Column dMaxCol Then Exit Sub If IsEmpty(Target.Offset(-1, 0).Value) Then Exit Sub Application.EnableEvents = False If IsEmpty(Me.Cells(Target.Row, dMaxCol).Value) Or _ Me.Cells(Target.Row, dMaxCol).Value >= Me.Cells(Target.Row + 1, dMaxCol).Value Then lCol = Target.Column If IsEmpty(Target.Value) Then Target.EntireRow.Insert (xlShiftDown) lRow = Target.Row - 1 Else Target.Offset(1, 0).EntireRow.Insert (xlShiftDown) lRow = Target.Row + 1 If Target.Column lxCol Me.Cells(lRow, lxCol).Value = Me.Cells(lRow - 1, lxCol).Value End Select Next lxCol Cancel = True Else MsgBox "Impossible to insert level!", vbOKOnly + vbExclamation, "Insert Level" End If Application.EnableEvents = True End Sub

Hi Jessica,
Also dieser Code könnte so ungefähr funktionieren, wie du dir das vorstellst. Probier in mal in deiner Beispieltabelle aus. Er beinhaltet nun die Dezimalklassifikation & die Summenbildung (mit Auswahl Formel oder Wert). Im Moment sind die Konstanten so gesetzt, dass sie auf deine Beispielmappe (2) ausgelegt sind:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'   Code for a simple decimal classification
'   Row before target.row must already be filled (i.e. Row 1 contains initial start)
'   the level below the one clicked is increased be 1
'   clicking a empty cell below one of highest level increases highest level
Const dStart = 0            ' Start first level (e.g. 0 or 1)
Const dMinCol = 6           ' min Column
Const dMaxCol = 10          ' max Column
Const dSumCol = 17          ' Column for building a sum value or formula
Dim lCol As Long, lxCol As Long, lRow As Long
Dim sFormula As String
lRow = ActiveSheet.Cells(1, dMinCol).End(xlDown).Row
If Target.Count = 1 And Target.Row  0 Then
sFormula = sFormula & "(" & Me.Cells(Target.Row + 1, lCol).Address(0, 0) & _
":" & Me.Cells(lRow, lCol).Address(0, 0) & "=0"
Else
sFormula = sFormula & "(" & Me.Cells(Target.Row + 1, lCol).Address(0, 0) & _
":" & Me.Cells(lRow, lCol).Address(0, 0) & ">0"
lxCol = lCol
End If
Else
sFormula = sFormula & "(" & Me.Cells(Target.Row + 1, lCol).Address(0, 0) & _
":" & Me.Cells(lRow, lCol).Address(0, 0) & "=" & _
Me.Cells(Target.Row, lCol).Address(0, 0)
End If
sFormula = sFormula & ")*"
Next lCol
sFormula = sFormula & "(" & Me.Cells(Target.Row + 1, dSumCol).Address(0, 0) & _
":" & Me.Cells(lRow, dSumCol).Address(0, 0) & "))"
Select Case MsgBox("YES = Insert FORMULA" & vbCrLf & _
"NO  = Insert VALUE  ", vbYesNoCancel, "Insert SUM")
Case vbYes
Target.Formula = sFormula
Case vbNo
Target.Value = Evaluate(sFormula)
End Select
Application.EnableEvents = True
Cancel = True
Exit Sub
End If
If Target.Row = 1 Or Target.Count > 1 Or _
Target.Column  dMaxCol Then Exit Sub
If IsEmpty(Target.Offset(-1, 0).Value) Then Exit Sub
Application.EnableEvents = False
If IsEmpty(Me.Cells(Target.Row, dMaxCol).Value) Or _
Me.Cells(Target.Row, dMaxCol).Value >= Me.Cells(Target.Row + 1, dMaxCol).Value Then
lCol = Target.Column
If IsEmpty(Target.Value) Then
Target.EntireRow.Insert (xlShiftDown)
lRow = Target.Row - 1
Else
Target.Offset(1, 0).EntireRow.Insert (xlShiftDown)
lRow = Target.Row + 1
If Target.Column  lxCol
Me.Cells(lRow, lxCol).Value = Me.Cells(lRow - 1, lxCol).Value
End Select
Next lxCol
Cancel = True
Else
MsgBox "Impossible to insert level!", vbOKOnly + vbExclamation, "Insert Level"
End If
Application.EnableEvents = True
End Sub

GreetZ Renée

Beliebteste Forumthreads (12 Monate)

Zellen Sperren wenn Eingabe in übergeordnete Zeile

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen Sperren wenn Eingabe in übergeordnete Zeile

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread