Office: (Office 2013) Prozedur aufteilen

Helfe beim Thema Prozedur aufteilen in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, in der angehängten Tabelle habe ich in Tabelle 1 einen VBA Code hinterlegt, bei dem leider die Prozedur zu groß ist. Ich habe im Internet... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Naddus0207, 22. November 2016.

Seite 1 von 2
  1. NADDUS0207
    Naddus0207 Erfahrener User

    Prozedur aufteilen


    Hallo,

    in der angehängten Tabelle habe ich in Tabelle 1 einen VBA Code hinterlegt, bei dem leider die Prozedur zu groß ist. Ich habe im Internet gelesen, dass ich das ganze in Teilprozeduren aufteilen kann und nacheinander ablaufen lassen kann. Nur habe ich leider keinen blassen Schimmer wie ich das anstellen kann bzw. verstehe ich nicht wie, da ich mich noch nicht lange mit VBA beschäftige. Kann mir vielleicht jemand helfen den Code aufzuteilen oder anschaulich erklären, wie ich das bewerkstelligen kann?

    Die beiden Codeteile, die sich auf die Targets I11 und AA11 beziehen stellen quasi den Startpunkt für die jeweils darunter folgenden Anweisungen dar. Danach sollen die jeweils darunter folgenden Schritte in der Reihenfolge ausgeführt werden, wie ich sie geschrieben habe.

    Danke
     

    Anhänge:

    Naddus0207, 22. November 2016
    #1
  2. Beverly
    Beverly Erfahrener User
    Hi,

    den kompletten Teil für Zelle I11 kannst du m.E. durch diesen Teil ersetzen:

    Code:
        Dim lngZeile As Long
    If Target.Cells(1).Address(False, False) = "I11" Then
        If Target > 1 And Target < 13 Then
            ActiveSheet.Unprotect ("123")
            Application.EnableEvents = False
            For lngZeile = 1 To Target.Value
                Cells(lngZeile + 11, 3) = Chr(64 + lngZeile)
                Cells(lngZeile + 11, 2) = lngZeile
            Next lngZeile
            With Range(Cells(lngZeile + 11, 2), Cells(24, 4))
                .ClearContents
                .Locked = True
            End With
            Range(Cells(12, 4), Cells(lngZeile + 10, 4)).Locked = False
            Cells(lngZeile + 10, 4).Select
            Application.EnableEvents = True
            ActiveSheet.Protect ("123")
        End If
   End If

    Und schon ist die Prozedur nicht mehr zu lang.

    Bis später,
    Karin
     
    Beverly, 22. November 2016
    #2
  3. NADDUS0207
    Naddus0207 Erfahrener User
    Hi Beverly,

    danke für die Antwort. In meiner Tabelle soll in I11 Zahlen von 2 - 13 eingegeben werden. Wie kann ich dann deinen Code anpassen?

    Also If Target > 1 And Target < 14 Then
    habe ich noch hinbekommen, dann entsperrt es sich auch bis D24, aber in B24 und C24 wird nichts eingetragen und ich weiß nicht was ich dafür ändern muss.
     
    Zuletzt bearbeitet: 23. November 2016
    Naddus0207, 23. November 2016
    #3
  4. NADDUS0207
    Naddus0207 Erfahrener User

    Prozedur aufteilen

    Also wenn ich den Code so ändere:

    Code:
        Dim lngZeile As Long
    If Target.Cells(1).Address(False, False) = "I11" Then
        If Target > 1 And Target < 14 Then
            ActiveSheet.Unprotect ("123")
            Application.EnableEvents = False
            For lngZeile = 1 To Target.Value
                Cells(lngZeile + 10, 3) = Chr(64 + lngZeile)
                Cells(lngZeile + 10, 2) = lngZeile
            Next lngZeile
            With Range(Cells(lngZeile + 10, 2), Cells(24, 4))
                .ClearContents
                .Locked = True
            End With
            Range(Cells(12, 4), Cells(lngZeile + 10, 4)).Locked = False
            Cells(lngZeile + 10, 4).Select
            Application.EnableEvents = True
            ActiveSheet.Protect ("123")
        End If
   End If
    dann werden bei der Eingabe von 13 in I11 in die Spalte B die Zahlen von 1 - 13 geschrieben und in C die Werte A - M und die Zellen D12 : D14 entsperren sich. Allerdings startet die Eingabe in B und C nicht in Zeile 12, sondern in Zeile 11 und egal was ich anpasse komme ich nicht auf Zeile 12 als Startpunkt?
     
    Naddus0207, 23. November 2016
    #4
  5. BOSKOBIATI
    BoskoBiati Erfahrener User
    Hallo,

    lngZeile=2 oder lngZeile+11 ???????
     
    BoskoBiati, 23. November 2016
    #5
  6. Beverly
    Beverly Erfahrener User
    Versuche es mal so:

    Code:
        If Target.Cells(1).Address(False, False) = "I11" Then
        If Target > 1 And Target < 14 Then
            ActiveSheet.Unprotect ("123")
            Application.EnableEvents = False
            Range("B12:D24").ClearContents
            For lngZeile = 1 To Target.Value
                Cells(lngZeile + 11, 3) = Chr(64 + lngZeile)
                Cells(lngZeile + 11, 2) = lngZeile
            Next lngZeile
            Range(Cells(12, 4), Cells(lngZeile + 10, 4)).Locked = False
            Cells(lngZeile + 10, 4).Select
            Application.EnableEvents = True
            ActiveSheet.Protect ("123")
        End If
   End If
    Bis später,
    Karin
     
    Beverly, 23. November 2016
    #6
  7. NADDUS0207
    Naddus0207 Erfahrener User
    lngZeile=2 kommt der Sache schon nahe, es beginnt bei Eingabe von 13 in I11 in Zeile 12 aber in B nur 2 - 13 und in Spalte C nur B - M.
    lngZeile + 11 beginnt zwar in Zeile 12 aber bei Eingabe von 13 in I11 steht in B trotzdem nur 1 - 12 und in C A -L.
     
    Naddus0207, 23. November 2016
    #7
  8. NADDUS0207
    Naddus0207 Erfahrener User

    Prozedur aufteilen

    Hallo Beverly,

    Ich danke dir, jetzt passt es. Aber nur aus Interesse, hätte ich deinen ersten Code noch irgendwie anpassen können?
     
    Naddus0207, 23. November 2016
    #8
  9. NADDUS0207
    Naddus0207 Erfahrener User
    Hallo Beverly,

    kann ich den Code für die Eingabe in AA11 so anpassen:

    Code:
        If Target.Cells(1).Address(False, False) = "AA11" Then
        If Target > 1 And Target < 14 Then
            ActiveSheet.Unprotect ("123")
            Application.EnableEvents = False
            Range("Q12:V24").ClearContents
            For lngZeile = 1 To Target.Value
                Cells(lngZeile + 11, 18) = Chr(64 + lngZeile)
                Cells(lngZeile + 11, 17) = lngZeile
            Next lngZeile
            Range(Cells(12, 19), Cells (12, 20), Cells (12, 21), Cells(lngZeile + 10, 19)).Locked = False
            Cells(lngZeile + 10, 19).Select
            Application.EnableEvents = True
            ActiveSheet.Protect ("123")
        End If
   End If
    ?
     
    Zuletzt bearbeitet: 23. November 2016
    Naddus0207, 23. November 2016
    #9
  10. NADDUS0207
    Naddus0207 Erfahrener User
    Hab ihn so angepasst, das funktioniert:

    Code:
    If Target.Cells(1).Address(False, False) = "AA11" Then
        If Target > 1 And Target < 14 Then
            ActiveSheet.Unprotect ("123")
            Application.EnableEvents = False
            Range("Q12:V24").ClearContents
            For lngZeile = 1 To Target.Value
                Cells(lngZeile + 11, 18) = Chr(64 + lngZeile)
                Cells(lngZeile + 11, 17) = lngZeile
            Next lngZeile
            Range(Cells(12, 19), Cells(lngZeile + 10, 19)).Locked = False
            Range(Cells(12, 20), Cells(lngZeile + 10, 20)).Locked = False
            Range(Cells(12, 21), Cells(lngZeile + 10, 21)).Locked = False
            Cells(lngZeile + 10, 19).Select
            Application.EnableEvents = True
            ActiveSheet.Protect ("123")
        End If
   End If
     
    Naddus0207, 23. November 2016
    #10
  11. Beverly
    Beverly Erfahrener User
    Hi,

    ja, man hätte ihn noch anpassen können, aber das wäre dann eine umständliche If-Abfrage gewesen - indem nun zuerst alle Zellen auf einmal geleert werden, spart man sich die komplizierte Umrechnung der Zeilennummern.

    Bis später,
    Karin
     
    Beverly, 23. November 2016
    #11
  12. Beverly
    Beverly Erfahrener User
    Diese 3 Zeilen

    Code:
                Range(Cells(12, 19), Cells(lngZeile + 10, 19)).Locked = False
            Range(Cells(12, 20), Cells(lngZeile + 10, 20)).Locked = False
            Range(Cells(12, 21), Cells(lngZeile + 10, 21)).Locked = False

    kannst du wie in meinem Code zusammenfassen - bei einem zusammenhängenden Zellbereich muss nur die Adresse der Startzelle und die Adresse der Endzelle angegeben werden:

    Code:
    Range([COLOR=#0000ff]Cells(12, 19)[/COLOR], [COLOR=#b22222]Cells(lngZeile + 10, 21)[/COLOR]).Locked = False

    Bis später,
    Karin
     
    Beverly, 23. November 2016
    #12
  13. BOSKOBIATI
    BoskoBiati Erfahrener User

    Prozedur aufteilen

    Hallo,

    hat etwas länger gedauert, aber hier mal den kompletten Code aus der Tabelle gekürzt:

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngZeile As Long
Dim loA As Long
Dim loB As Long
If Target.Cells(1).Address(False, False) = "I11" Then
    If Target > 1 And Target < 14 Then
            ActiveSheet.Unprotect ("123")
            For lngZeile = 1 To Target
                Range("C" & lngZeile + 11) = Chr(64 + lngZeile)
                Range("B" & lngZeile + 11) = lngZeile
                Range("B" & lngZeile + 13 & ":D24").ClearContents
                Range("B" & lngZeile + 13 & ":D24").Locked = True
                Range("D12:D" & lngZeile + 12).Locked = False
            Next
            Range("D12").Select
            ActiveSheet.Protect ("123")
    End If
End If
If Target.Cells(1).Address(False, False) = "AA11" Then
    If Target > 1 And Target < 14 Then
            ActiveSheet.Unprotect ("123")
            For lngZeile = 1 To Target
                Range("R" & lngZeile + 11) = Chr(64 + lngZeile)
                Range("R" & lngZeile + 11) = lngZeile
                Range("Q" & lngZeile + 13 & ":V24").ClearContents
                Range("S" & lngZeile + 13 & ":V24").Locked = True
                Range("S12:U" & lngZeile + 12).Locked = False
            Next
            Range("D12").Select
            ActiveSheet.Protect ("123")
    End If
End If
If Target.Column = 4 Then
    If Target.Row > 12 And Target.Row < 25 Then
        For loA = 12 To Target.Row - 1
            If Range("D" & loA) <> "" Then loB = loB + 1
        Next
        If Target <> "" And Range("I11") = loA - 10 And loB = loA - 10 Then
            ActiveSheet.Unprotect ("123")
            Range("D25").Locked = False
            Range("D25").Select
            ActiveSheet.Protect ("123")
        End If
    End If
    If Target.Row = 25 Then
        For loA = 13 To Target.Row - 1
            If Target = Application.Sum(Range("D12:D" & loA)) And Range("I11") = loA - 10 Then
                ActiveSheet.Unprotect ("123")
                Range("D29").Locked = False
                Range("D29").Select
                ActiveSheet.Protect ("123")
            End If
        Next
    End If
    If Target.Row = 29 Then
            If Target = Range("D25") And Target <> "" Then
                ActiveSheet.Unprotect ("123")
                Range("D30").Locked = False
                Range("D30").Select
                ActiveSheet.Protect ("123")
            End If
    End If
    If Target.Row = 30 Then
        If Target = Range("I11") And Target <> "" Then
            ActiveSheet.Unprotect ("123")
            Range("F29:F30").Locked = False
            Range("F29:F30").Select
            ActiveSheet.Protect ("123")
        End If
    End If
End If

If Target.Column = 21 And Target.Row > 11 And Target.Row < 25 Then
        If Target <> "" And Range("S" & Target.Row) <> "" And Range("T" & Target.Row) <> "" Then
            ActiveSheet.Unprotect ("123")
            Range("V" & Target.Row).Locked = False
            Range("V" & Target.Row).Select
            ActiveSheet.Protect ("123")
        End If
End If
If Target.Column = 19 And Target.Row > 12 And Target.Row < 25 Then 's24
    loB = 0
    For loA = 12 To Target.Row - 1
        If Range("S" & loA) <> "" Then loB = loB + 1
    Next
        If Target <> "" And Range("AA11") = Target.Row - 10 And loB = Target.Row - 12 Then
            ActiveSheet.Unprotect ("123")
            Range("S25").Locked = False
            Range("S25").Select
            ActiveSheet.Protect ("123")
        End If
End If
If Target.Column = 22 Then
    If Target.Row > 12 And Target.Row < 25 Then
        loB = 0
        For loA = 13 To Target.Row
            If Target = Application.Round(Range("T" & loA) * Range("S" & loA) / Range("U" & loA), 2) Then loB = loB + 1
        Next
        If loB = Target.Row - 12 And Range("AA11") = Target.Row - 11 Then
            ActiveSheet.Unprotect ("123")
            Range("V25").Locked = False
            Range("V25").Select
            ActiveSheet.Protect ("123")
        End If
    End If
    If Target.Row = 25 Then
        loB = 0
        For loA = 2 To 13
            If Target = Application.Sum(Range("V12:V" & loA + 11)) And Range("AA11") = loA Then loB = 1
        Next
        If loB = 1 Then
            ActiveSheet.Unprotect ("123")
            Range("V29").Locked = False
            Range("V29").Select
            ActiveSheet.Protect ("123")
        End If
    End If
    If Target.Row = 29 Then
        If Target = Range("V25") And Target <> "" Then
            ActiveSheet.Unprotect ("123")
            Range("V30").Locked = False
            Range("V30").Select
            ActiveSheet.Protect ("123")
        End If
    End If
    If Target.Row = 30 Then
        If Target = Range("AA11") And Target <> "" Then
            ActiveSheet.Unprotect ("123")
            Range("X29:X30").Locked = False
            Range("X29:X30").Select
            ActiveSheet.Protect ("123")
        End If
    End If
End If
End Sub
     
    BoskoBiati, 23. November 2016
    #13
  14. Beverly
    Beverly Erfahrener User
    Hi,

    die Verwendung der Schreibweise Range ("C" & lngZeile) als variable Zellansprache ist nicht unbedingt empfehlenswert, da Excel intern Zellbezüge immer im Format Zelle(Zeilennummer, Spaltennummer) also Cells(lngZeile, 3) verwendet. Die Folge ist, dass Excel den Spaltenbuchstaben erst in die Spaltennummer umrechnen und dann alles in die intern verwendete Schreibweise umwandeln muss - das bremst die Codeausführung unnötig aus.

    Bis später,
    Karin
     
    Beverly, 23. November 2016
    #14
  15. BOSKOBIATI
    BoskoBiati Erfahrener User
    Hallo Karin,


    da kann der TE sich mit auseinandersetzen, die Arbeit wollte ich mir nicht auch noch machen.
     
    BoskoBiati, 23. November 2016
    #15
Seite 1 von 2
Thema:

Prozedur aufteilen

Die Seite wird geladen...

  1. Prozedur aufteilen - Similar Threads - Prozedur aufteilen

  2. Prozedur ist zu groß

    in Microsoft Excel Hilfe
    Prozedur ist zu groß: Hallo ich habe ein Problem und zwar werden sehr viele Kombinationsfelder beim Öffnen eines Excel Workbook gefüllt. Diese führt jetzt zu einer zu großen Prozedur. Hätte da jemand eine Lösung? Gruß...

  3. Prozeduren über eine globale Vorlage ausführen

    in Microsoft Word Hilfe
    Prozeduren über eine globale Vorlage ausführen: Hallo! Ich möchte gerne verschiedene Prozeduren in einer zentralen (globalen) Vorlage erstellen und auf diese Prozeduren bzw Funktionen mit jedem neuen Dokument insbesondere neuen Dokumenten, die...

  4. Sub-Prozedur in der Schleife

    in Microsoft Access Hilfe
    Sub-Prozedur in der Schleife: Liebe Access-Profis, wieder mal weiß ich nicht weiter: Ich habe ein Formular, indem ich 41 Bezeichnungsfelder ('Bez0 – Bez40') und ebenso viele Textfelder ('txtRedSch0 – txtRedSch40')...

  5. Gespeicherte Prozedur Eigenschaftenseite (ADP)

    in Microsoft Access Tutorials
    Gespeicherte Prozedur Eigenschaftenseite (ADP): Gespeicherte Prozedur Eigenschaftenseite (ADP) Access 2010 Access 2007 Mehr... Weniger...

  6. Gespeicherte Prozedur Parameter Eigenschaftenseite (ADP)

    in Microsoft Access Tutorials
    Gespeicherte Prozedur Parameter Eigenschaftenseite (ADP): Gespeicherte Prozedur Parameter Eigenschaftenseite (ADP) Access 2010 Access 2007 Mehr... Weniger...

  7. VBA - Prozedur zu groß

    in Microsoft Excel Hilfe
    VBA - Prozedur zu groß: Hallo, ich erzeuge mit Hilfe von Excel via VBA eine XML-Datei. Diese ist leider sehr groß (über 330.000 Zeichen auf mehreren tausend Zeilen), weshalb ich die Prozedur auf 2 Prozeduren aufgeteilt...

  8. Probleme mit Prozeduren

    in Microsoft Excel Hilfe
    Probleme mit Prozeduren: Hallo, ich hab ein kleines Problem mit Prozeduren. Der Code führt die eingeschobene Prozedur nicht in der neu erstellten Mappe aus, sondern in der alten Ursprünglichen Mappe. Ich hoffe ihr...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Akzeptieren Weitere Informationen...
    Information ausblenden