Zellen Sperren wenn Eingabe in übergeordnete Zeile

Jessica · 2008-05-07T15:40:00+00:00

Hallo ihr Lieben, draußen ist so schönes Wetter und ich sitze hier und bin am Verzweifeln. Ich habe jetzt ca. 300 Zeilen mit einer Katalog-Struktur 0 00 0 0 0 angelegt die fortlaufend ist. d.h. desto feiner desto größer die Zahl 0 01 0 0 0 kleiner 0 01 1 0 0 kleiner 0 29 0 0 0 usw. Bei der ersten Zahl (oben 0) sehe ich, ob eine neue Katalog-Struktur beginnt. d.h. 1 00 0 0 0 (neue Struktur) 2 00 0 0 0 (neue Struktur) Ich möchte so ein Exceldatenblatt erstellen bei dem ich offen lasse, ob ich in die oberste Katalogstruktur, also die kleinstmögliche Zahlenkombination mit einem Wert versehe, oder ob die oberste Katalogstruktur sich die Werte aus den feineren Ebenen zusammenrechnet (addiert). Irgendwie habe ich mir das einfacher vorgestellt, bis mir eingefallen ist, dass man ja nicht immer die tiefen Details zur Verfügung hat, die die oberste Katalogstruktur ergeben würden, sondern, dass manchmal auch nur eine Schätzeingabe genügen müsste, die direkt in die oberste Struktur gesetzt wird. :-( Ich bin verzweifelt, anbei mal eine Mappe zur Erläuterung was ich damit meine (es ist nur eine Struktur dargestellt). Hat jemand soetwas schonmal gemacht, oder wüsste wie soetwas aufzubauen wäre. Danke schomal für die Rückmeldungen! Lg Jessica

Hi Jessica,
Versuch es mal mit diesem Code (er gehört in die Tabelle1 deines Beispiels).
Statt einem Eintrag, reagiert er auf einen Doppelklick innerhalb der bereits bestehenden Tabelle, oder am Ende der Tabelle. Dabei spielt es eine entscheidene Rolle, in welche Kolonne du doppel-klickst. Je nachdem werden die Zahlen anders erhöht.


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

GreetZ Renée
P.S. bei gewissen Konstellationen, ist noch nicht alles i.O. ;-)

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

Zellen Sperren wenn Eingabe in übergeordnete Zeile

Forumthread: Zellen Sperren wenn Eingabe in übergeordnete Zeile

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Zellen Sperren wenn Eingabe in übergeordnete Zeile

Forumthread: Zellen Sperren wenn Eingabe in übergeordnete Zeile

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread