Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Zellen Sperren wenn Eingabe in übergeordnete Zeile

Betrifft: Zellen Sperren wenn Eingabe in übergeordnete Zeile von: Jessica
Geschrieben am: 07.05.2008 15:40:46

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

  

Betrifft: Dateiupload von: Jessica
Geschrieben am: 07.05.2008 15:43:12

https://www.herber.de/bbs/user/52199.xls


  

Betrifft: AW: Dateiupload von: Jessica
Geschrieben am: 08.05.2008 08:27:39

Hat da keiner eine Idee, oder ist das Ganze zu umfangreich?
ich könnte die Datei auch anders aufbauen? Lg


  

Betrifft: AW: Dateiupload von: Renee
Geschrieben am: 08.05.2008 11:11:21

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 < dMaxCol Then lCol = lCol + 1
        End If
        For lxCol = 1 To dMaxCol
            Select Case lCol
            Case Is = lxCol
                Me.Cells(lRow, lxCol).Value = Me.Cells(lRow - 1, lxCol).Value + 1
            Case Is < lxCol
                Me.Cells(lRow, lxCol).Value = dStart
            Case Is > 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. ;-)


  

Betrifft: AW: Dateiupload von: Jessica
Geschrieben am: 09.05.2008 13:45:50

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


  

Betrifft: hier der neue Upload, vielleicht eindeutiger... von: Jessica
Geschrieben am: 09.05.2008 13:49:36

hier die neue Mappe :-)
https://www.herber.de/bbs/user/52262.xls


  

Betrifft: Dezimalklassifikation automatisieren von: Renee
Geschrieben am: 09.05.2008 13:52:50

Hi Jessi,

Wenn du mir was von deinen eingesparten Stunden überlassen kannst ;-) und v.a. deine neue Bespielmappe hochlädst, kann ich vielleicht nachvollziehen, was du genau willst.

Wenn du in der Beispielmappe noch die Regeln genauer erläuterst ist die Chance für eine Lösung noch grösser.

GreetZ Renée


  

Betrifft: AW: Dezimalklassifikation automatisieren von: Jessica
Geschrieben am: 09.05.2008 14:04:39

Hallo Renée,

neue Mappe ist ein Post über Deinem ;-)

sonnige Grüße!


  

Betrifft: AW: Dezimalklassifikation automatisieren von: Renee
Geschrieben am: 09.05.2008 15:51:51

Hallo Jessica,

Mit einer kleinen Anpassung, sollte der Code eigentlich auch für deine 'neue' Mappe stimmen.
Ich sehe nur ein einfache Dezimalklassifikation und darauf ist mein Code aufgebaut. Kannst du mir sagen, was am Code den nicht so läuft, wie du es willst ?

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 < dMinCol 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 < dMaxCol Then lCol = lCol + 1
        End If
        For lxCol = dMinCol To dMaxCol
            Select Case lCol
            Case Is = lxCol
                Me.Cells(lRow, lxCol).Value = Me.Cells(lRow - 1, lxCol).Value + 1
            Case Is < lxCol
                Me.Cells(lRow, lxCol).Value = dStart
            Case Is > 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


  

Betrifft: AW: Dezimalklassifikation automatisieren von: Jessica
Geschrieben am: 09.05.2008 19:03:24

Hallo Renée, erstmal nochmal DANKE, dass Du mir dabei hilfst.
Ich habe mir jetzt nochmal durchgelesen was Du geschrieben hast und bin jetzt auf die Idee gekommen mal nicht in den Summenbereich zu drücken und ein Ereignis zu erwarten, sondern in die Katalogabfolge ;-). Siehe da, der Code funktioniert und füllt die Nummern auf...

ABER: Da habe ich mich sicherlich total missverständlich ausgedrückt, die Katalog-Nr. wäre ja vorgegeben, es geht mir ja um die Betragszusammenzählung, die entweder mit Direkteinträgen befüllt wird bzw. die darunterliegenden Reihen, die ggf. (!) - aber nicht zwingend vorhanden sein müssen - einer anderen Obergruppe zugehören.

Gebe ich z.B. bei Grundstück (Q1) einen Wert X ein, sollen die Untergruppierungen Q2, Q9, Q10 (die normalerweise Q1 ergeben) für Einträge gesperrt werden. Die Logik beruht ja auf der Katalog-Nr. Ordnung.

LG
Jessi

PS: Das tolle ist allerdings, dass ich diesen Code für die Befüllung anderer Katalog-Nr. nutzen werde ;-) Ersparnis mehr als 30 Minuten ;-) hihi!


  

Betrifft: Summe Dezimalklassifikation von: Renee
Geschrieben am: 09.05.2008 22:01:23

Hi Jessi,

Ja da haben wir uns gründlich missverstanden. Ich bin nochmals die Posts durchgegangen und sehe jetzt das du von Werten geschrieben hast. Hättest du Summen oder Summenbildung erwähnt, wäre es vielleicht besser aufgefallen. Na, ja ich werd mir morgen mal Zeit nehmen um das hinzubiegen.

GreetZ Renée


  

Betrifft: AW: Summe Dezimalklassifikation von: Konrad
Geschrieben am: 09.05.2008 23:00:27

Hi Rene,

also für mich bist du ein Held.

mfg Konrad


  

Betrifft: AW: Summe Dezimalklassifikation von: Jessica
Geschrieben am: 11.05.2008 10:06:09

super...aber wie gesagt, die Dezimaljkassifikation der Katalog-Nr. sollte auch nicht umsonst sein ;-)


  

Betrifft: AW: Summe Dezimalklassifikation von: Renee
Geschrieben am: 13.05.2008 10:24:28

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 < lRow _
                        And Target.Column = dSumCol Then
        Application.EnableEvents = False
        lRow = ActiveSheet.Cells(1, dMinCol).End(xlDown).Row
        sFormula = "=SUMPRODUCT("
        For lCol = dMinCol To dMaxCol
            If Me.Cells(Target.Row, lCol) = 0 Then
                If lxCol > 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 < dMinCol 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 < dMaxCol Then lCol = lCol + 1
        End If
        For lxCol = dMinCol To dMaxCol
            Select Case lCol
            Case Is = lxCol
                Me.Cells(lRow, lxCol).Value = Me.Cells(lRow - 1, lxCol).Value + 1
            Case Is < lxCol
                Me.Cells(lRow, lxCol).Value = dStart
            Case Is > 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


 

Beiträge aus den Excel-Beispielen zum Thema "Zellen Sperren wenn Eingabe in übergeordnete Zeile"