@ Renee bzgl. Dezimalklassifikation

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 = 20          ' 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

Klappt alles super, aber gibt es eine Möglichkeit, dass ich anstelle der Summe über "dSumCol = 20" (wäre hier Spalte T) über die gleiche Dezimalklassifikation die Rechnung über eine einfache Multiplikation von dem Wert der in Spalte Q x S steht errechnen lasse. Das sollte dann Spalte T ergeben und DIESE sollte dann ausgerechnet werden. Ich habe bei meiner Betrachtung nämlich vergessen, dass ich keine festen €Werte eingeben, sondern nur die Massen (Q) und Preise(S) und die erst die Summe (T) ergeben. ;-(
Wäre super, wenn Du mir da helfen könntest! Gerne auch andere...:-)
Lg
Jessi