Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Makro Daten zusammenfassen

Thema geschlossen 
Baumstrukturmodus
Makro Daten zusammenfassen
DieMarie Offline
Benutzer
ThreadStarter

Registriert seit: 14.01.2019
Version(en): 365
#11
18.06.2021, 10:02 (Dieser Beitrag wurde zuletzt bearbeitet: 18.06.2021, 10:03 von DieMarie.)
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
Suchen
Antworten Top
Klaus-Dieter Offline
Excel und VBA
Registriert seit: 11.04.2014
Version(en): Office 365
#12
18.06.2021, 10:58
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.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Homepage Suchen
Antworten Top
DieMarie Offline
Benutzer
ThreadStarter

Registriert seit: 14.01.2019
Version(en): 365
#13
18.06.2021, 13:25
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".
Suchen
Antworten Top
EA1950 Offline
Benutzer
Registriert seit: 02.12.2017
Version(en): Microsoft365
#14
18.06.2021, 13:48 (Dieser Beitrag wurde zuletzt bearbeitet: 18.06.2021, 13:50 von EA1950.)
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.
Mit lieben Grüßen
Anton.

Windows 10 64bit
Office365 32bit
Suchen
Antworten Top
Klaus-Dieter Offline
Excel und VBA
Registriert seit: 11.04.2014
Version(en): Office 365
#15
18.06.2021, 14:03
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.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Homepage Suchen
Antworten Top
EA1950 Offline
Benutzer
Registriert seit: 02.12.2017
Version(en): Microsoft365
#16
18.06.2021, 14:23
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).
Mit lieben Grüßen
Anton.

Windows 10 64bit
Office365 32bit
Suchen
Antworten Top
Klaus-Dieter Offline
Excel und VBA
Registriert seit: 11.04.2014
Version(en): Office 365
#17
18.06.2021, 15:17
Hallo,

dann muss man das eben trennen. Wie ich anfangs schon angemerkt hatte, halte ich ohnehin nichts von solchen Arbeitsweisen.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Homepage Suchen
Antworten Top
EA1950 Offline
Benutzer
Registriert seit: 02.12.2017
Version(en): Microsoft365
#18
18.06.2021, 15:21
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.


Angehängte Dateien
.xlsm   DieMarie_Zusammenfassung.xlsm (Größe: 30,28 KB / Downloads: 4)
Mit lieben Grüßen
Anton.

Windows 10 64bit
Office365 32bit
[-] Folgende(r) 1 Nutzer sagt Danke an EA1950 für diesen Beitrag:
  • DieMarie
Suchen
Antworten Top
DieMarie Offline
Benutzer
ThreadStarter

Registriert seit: 14.01.2019
Version(en): 365
#19
21.06.2021, 19:14
Vielen Dank EA1950
Das funktioniert perfekt :)
Suchen
Antworten Top
PIVPQ Abwesend
Benutzer
Registriert seit: 19.12.2020
Version(en): Microsoft 365 (32/64 Bit)
#20
21.06.2021, 19:32
Hallo

Ich würde das ganze eventuell ohne VBA mit PQ machen.
Viele Grüße
PIVPQ
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste