Clever-Excel-Forum

Seiten: 1 2

Ein kleines Problemchen habe ich aber noch.

Ich lese so viele Zeilen und Zellen aus, dass er die Fehlermeldung "Prozedur zu groß" auswirft.

Wenn ich 3 Zeilen die ich auslese auskommentiere läuft es.
Ich weiß leider nicht, wie / wo man trennen kann um zwei Prozeduren daraus zu machen.

Code:
Sub Zusammenfassung_auflisten()

   Dim sPfad As String, sDateiName As String

   Dim WbQ As Workbook, WsQ As Worksheet, WsP As Worksheet

   Dim iRow As Integer

   'Ordner Pfad aus Zelle E1 laden

   sPfad = Worksheets("Funktionen").Range("E1").Value

   If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"

   sDateiName = Dir$(sPfad & "*.xls*")

   On Error GoTo Err_Zusammenfassung

   With Worksheets("Funktionen")

       'Alte Tabelle komplett löschen

       .UsedRange.Offset(11, 0).ClearContents

       Application.ScreenUpdating = False

      '1.Zeilennr. iRow ist im  Zielarbeitsblatt "Funktionen" die Zeile für "Total Primary costs"

       iRow = 12  '1.Zeile

       Do While Len(sDateiName)

          'Zusammenfassung überspringen

          If InStr(sDateiName, "Zusammenfassung") = 0 Then

             'Quelldatei öffnen und auslesen

             Application.DisplayAlerts = False

             Set WbQ = Workbooks.Open(sPfad & sDateiName)

             Set WsP = WbQ.Worksheets("AOP_FY22")

             Set WsQ = WbQ.Worksheets("Functions_FC")

             '.Cells(iRow, 14) = sDateiName

             'alle Tabellen auf "Bezeichnung" und Anmerkung prüfen

             If (WsQ.Range("C10") = "Total Primary costs") And _

                (WsQ.Range("C11") = "Personnel costs") Then

'               .Cells(iRow, 13).Value = WsQ.Name

               'iRow: 1.Zeilennr. ist im  Zielarbeitsblatt "Functions_FC" die Zeile für "Total Primary costs"

               .Cells(iRow, 1).Value = WsP.Range("A12")

               .Cells(iRow, 2).Value = WsP.Range("B12")

               .Cells(iRow, 3).Value = WsP.Range("C12")

               .Cells(iRow, 4).Value = WsP.Range("D12")

               .Cells(iRow, 5).Value = WsP.Range("E12")

               .Cells(iRow, 7).Value = WsQ.Range("F10")

               .Cells(iRow, 8).Value = WsQ.Range("I10")

               .Cells(iRow, 9).Value = WsQ.Range("K10")

               .Cells(iRow, 10).Value = WsQ.Range("M10")

               .Cells(iRow, 11).Value = WsQ.Range("O10")

               .Cells(iRow, 12).Value = WsQ.Range("Q10")

               .Cells(iRow, 13).Value = WsQ.Range("S10")

               .Cells(iRow, 14).Value = WsQ.Range("U10")

               .Cells(iRow, 15).Value = WsQ.Range("W10")

               .Cells(iRow, 16).Value = WsQ.Range("Y10")

               .Cells(iRow, 17).Value = WsQ.Range("AA10")

               .Cells(iRow, 18).Value = WsQ.Range("AC10")

               .Cells(iRow, 19).Value = WsQ.Range("AE10")

               .Cells(iRow, 20).Value = WsQ.Range("AG10")

               .Cells(iRow, 21).Value = WsQ.Range("AI10")

               .Cells(iRow, 22).Value = WsQ.Range("AK10")

               .Cells(iRow, 23).Value = WsQ.Range("AM10")

               .Cells(iRow, 24).Value = WsQ.Range("AO10")

               .Cells(iRow, 25).Value = WsQ.Range("AQ10")

               .Cells(iRow, 26).Value = WsQ.Range("AS10")

               .Cells(iRow, 27).Value = WsQ.Range("AU10")

               .Cells(iRow, 28).Value = WsQ.Range("AW10")

               .Cells(iRow, 29).Value = WsQ.Range("AY10")

               .Cells(iRow, 30).Value = WsQ.Range("BA10")

               .Cells(iRow, 31).Value = WsQ.Range("BC10")

               .Cells(iRow, 32).Value = WsQ.Range("BE10")

               .Cells(iRow, 33).Value = WsQ.Range("BG10")

               .Cells(iRow, 34).Value = WsQ.Range("BI10")

               .Cells(iRow, 35).Value = WsQ.Range("BK10")

               .Cells(iRow, 36).Value = WsQ.Range("BM10")

               .Cells(iRow, 37).Value = WsQ.Range("BO10")

               .Cells(iRow, 38).Value = WsQ.Range("BQ10")

               .Cells(iRow, 39).Value = WsQ.Range("BS10")

               .Cells(iRow, 40).Value = WsQ.Range("BU10")

               .Cells(iRow, 41).Value = WsQ.Range("BW10")

               .Cells(iRow, 42).Value = WsQ.Range("BY10")

               .Cells(iRow, 43).Value = WsQ.Range("CA10")

               .Cells(iRow, 44).Value = WsQ.Range("CC10")

               .Cells(iRow, 45).Value = WsQ.Range("CE10")

               .Cells(iRow, 46).Value = WsQ.Range("CG10")

               .Cells(iRow, 47).Value = WsQ.Range("CI10")

               .Cells(iRow, 48).Value = WsQ.Range("CK10")

               .Cells(iRow, 49).Value = WsQ.Range("CM10")

               .Cells(iRow, 50).Value = WsQ.Range("CO10")

               .Cells(iRow, 51).Value = WsQ.Range("CQ10")

               .Cells(iRow, 52).Value = WsQ.Range("CS10")

               .Cells(iRow, 53).Value = WsQ.Range("CU10")

               .Cells(iRow, 54).Value = WsQ.Range("CW10")

               iRow = iRow + 1

               'iRow: 2.Zeilennr. ist im  Zielarbeitsblatt "Functions_FC" die Zeile für "Personnel costs"

               .Cells(iRow, 1).Value = WsP.Range("A13")

               .Cells(iRow, 2).Value = WsP.Range("B13")

               .Cells(iRow, 3).Value = WsP.Range("C13")

               .Cells(iRow, 4).Value = WsP.Range("D13")

               .Cells(iRow, 5).Value = WsP.Range("E13")

               .Cells(iRow, 7).Value = WsQ.Range("F11")

               .Cells(iRow, 8).Value = WsQ.Range("I11")

               .Cells(iRow, 9).Value = WsQ.Range("K11")

               .Cells(iRow, 10).Value = WsQ.Range("M11")

               .Cells(iRow, 11).Value = WsQ.Range("O11")

               .Cells(iRow, 12).Value = WsQ.Range("Q11")

               .Cells(iRow, 13).Value = WsQ.Range("S11")

               .Cells(iRow, 14).Value = WsQ.Range("U11")

               .Cells(iRow, 15).Value = WsQ.Range("W11")

               .Cells(iRow, 16).Value = WsQ.Range("Y11")

               .Cells(iRow, 17).Value = WsQ.Range("AA11")

               .Cells(iRow, 18).Value = WsQ.Range("AC11")

               .Cells(iRow, 19).Value = WsQ.Range("AE11")

               .Cells(iRow, 20).Value = WsQ.Range("AG11")

               .Cells(iRow, 21).Value = WsQ.Range("AI11")

               .Cells(iRow, 22).Value = WsQ.Range("AK11")

               .Cells(iRow, 23).Value = WsQ.Range("AM11")

               .Cells(iRow, 24).Value = WsQ.Range("AO11")

               .Cells(iRow, 25).Value = WsQ.Range("AQ11")

               .Cells(iRow, 26).Value = WsQ.Range("AS11")

               .Cells(iRow, 27).Value = WsQ.Range("AU11")

               .Cells(iRow, 28).Value = WsQ.Range("AW11")

               .Cells(iRow, 29).Value = WsQ.Range("AY11")

               .Cells(iRow, 30).Value = WsQ.Range("BA11")

               .Cells(iRow, 31).Value = WsQ.Range("BC11")

               .Cells(iRow, 32).Value = WsQ.Range("BE11")

               .Cells(iRow, 33).Value = WsQ.Range("BG11")

               .Cells(iRow, 34).Value = WsQ.Range("BI11")

               .Cells(iRow, 35).Value = WsQ.Range("BK11")

               .Cells(iRow, 36).Value = WsQ.Range("BM11")

               .Cells(iRow, 37).Value = WsQ.Range("BO11")

               .Cells(iRow, 38).Value = WsQ.Range("BQ11")

               .Cells(iRow, 39).Value = WsQ.Range("BS11")

               .Cells(iRow, 40).Value = WsQ.Range("BU11")

               .Cells(iRow, 41).Value = WsQ.Range("BW11")

               .Cells(iRow, 42).Value = WsQ.Range("BY11")

               .Cells(iRow, 43).Value = WsQ.Range("CA11")

               .Cells(iRow, 44).Value = WsQ.Range("CC11")

               .Cells(iRow, 45).Value = WsQ.Range("CE11")

               .Cells(iRow, 46).Value = WsQ.Range("CG11")

               .Cells(iRow, 47).Value = WsQ.Range("CI11")

               .Cells(iRow, 48).Value = WsQ.Range("CK11")

               .Cells(iRow, 49).Value = WsQ.Range("CM11")

               .Cells(iRow, 50).Value = WsQ.Range("CO11")

               .Cells(iRow, 51).Value = WsQ.Range("CQ11")

               .Cells(iRow, 52).Value = WsQ.Range("CS11")

               .Cells(iRow, 53).Value = WsQ.Range("CU11")

               .Cells(iRow, 54).Value = WsQ.Range("CW11")

               iRow = iRow + 1

' HIER KOMMEN NOCH 20 WEITERE ZEILEN

 End If

             'Aktive Mappe schliessen  (ohne Speichern)

             WbQ.Close savechanges:=False

          End If

Nxt_Zusammenfassung:

          sDateiName = Dir$()

       Loop

       Application.DisplayAlerts = True

    End With

    Exit Sub

Err_Zusammenfassung:

    MsgBox sDateiName & " diese Datei konnte nicht geöffnet werden!"

    Resume Nxt_Zusammenfassung

End Sub

Hallo Marie,

das hat mit den zu bearbeitenden Daten nichts zu tun, mit Prozedur ist das Makro selbst gemeint. Hier gibt es reichlich Potenzial zum Verkürzen.

Wärst du auch so lieb mir dabei bitte zu helfen?

Ich hatte bereits Markos die (in Summe) deutlich länger waren - nur eben nicht in einer "Funktion".

Hallo,

du hast gegen Ende der SUB folgenden Kommentar eingefügt:

' HIER KOMMEN NOCH 20 WEITERE ZEILEN

Dieser Kommentar ist für mich sinnlos - ich brauche diese 20 Zeilen, damit ich weiß, wie ich mit welchen SUB/FUNCTION-Aufrufen den Code aufplitten kann, damit die eine vorliegende SUB die 64-kB-Grenze nicht überschreitet.

Hallo Marie,

der erste Block zum Übertragen würde bei mir etwa so aussehen:

Code:
Option Explicit

Sub test()

    Dim varDatArr As Variant

    Dim intSpalte As Integer

    Dim intAnz As Integer

    varDatArr = Array("A12", "B12", "C12", "D12", "E12", "F10", "I10", "K10", "M10", "O10", "Q10", "S10", "U10", "W10", _

    "Y10", "AA10", "AC10", "AE10", "AG10", "AI10", "AK10", "AM10", "AO10", "AQ10", "AS10", "AU10", "AW10", "AY10", "BA10", _

    "BC10", "BE10", "BG10", "BI10", "BK10", "BM10", "BO10", "BQ10", "BS10", "BU10", "BW10", "BY10", "CA10", "CC10", "CE10", _

    "CG10", "CI10", "CK10", "CM10", "CO10", "CQ10", "CS10", "CU10", "CW10")

    For intSpalte = 1 To 100

        If intAnz = 53 Then Exit Sub

        Tabelle2.Cells(2, intSpalte) = Tabelle1.Range(varDatArr(intAnz))

        intAnz = intAnz + 1

    Next intSpalte

End Sub

Wobei es sicher auch noch andere Ansätze gäbe, aber die Vielzahl der zu übertragenden Inhalte habe ich in deiner Beispieldatei nicht gesehen, deshalb weiß ich auch nicht, wieso einzelne Spalten übersprungen werden. Möglicherweise gäbe es da noch andere Möglichkeiten. Wie auch immer, das spart schon mal rund 50 Zeilen Quelltext.

Hallo @Klaus-Dieter,

Danke für die Anregung - es gibt dabei ein kleines Problem, das beachtet werden muss:
Die Spalten A:E müssen aus einem anderen Quellblatt (WsP) bezogen werden als die restlichen Spalten (WsQ).

Hallo,

dann muss man das eben trennen. Wie ich anfangs schon angemerkt hatte, halte ich ohnehin nichts von solchen Arbeitsweisen.

Hallo,

ich habe im beiliegenden Makro die Sintflut an einzulesenden Spalten in eine SUB ausgelagert, wodurch sich die Größe der beteiligten SUBs erheblich verkleinerte.
Was ich natürlich nicht einbauen konnte sind die 20 Zeilen, die nur als Kommentarhinweis aufscheinen. Die müsstest du dann selbst einbauen.

Vielen Dank EA1950
Das funktioniert perfekt :)

Hallo

Ich würde das ganze eventuell ohne VBA mit PQ machen.

Seiten: 1 2

DieMarie

Klaus-Dieter

DieMarie

EA1950

Klaus-Dieter

EA1950

Klaus-Dieter

EA1950

DieMarie

PIVPQ