Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1464to1468
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Optimierung

Makro Optimierung
28.12.2015 18:30:09
Lutz
Hallo Zusammen,
ich bin neu hier im Forum und muss mich schon einmal pauschal, auch wenn ich noch nicht nach Hilfe gefragt habe bei den vielen Schreiberlingen hier bedanken.
Durch das Studium diverser Beiträge habe ich mir mittlerweile eine sehr schöne Excel, die meine tägliche Arbeit erleichtert angelegt.
Ich bin aber jetzt darauf gestoßen das man die Rechenleistung durch verschiedene Schritte optimieren kann und habe für meinen VBA-Code der prima läuft eine Frage:
Da ich MakroDidakt bin bitte ich meine vrsl. nicht ganz Programmierer getreue Fragestellung zu verzeihen.
Kann man zum Beispiel sagen kopiere den Bereich D2 bis EW2 beginnend mit Spalte A?
Vielen Dank für Anregungen gerne auch mit Tutorialhinweisen.
Lutz
Sub Auswertung_nach_Kunden_1()
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
Dim lngZeile As Long, rngZelle As Range
Set wksEingabe = Worksheets("AW_nach_runid")  'Eingabetabellenblatt
Set wksListe = Worksheets("Auswertung_nach_Kd")      'Tabellenblatt in das die Daten  _
geschrieben werden _
sollen
With wksListe
'nächste freie Zeile in Liste
Set rngZelle = .Cells.Find(What:="*", after:=.Range("A1"), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
lngZeile = 1
Else
lngZeile = rngZelle.Row + 1
End If
.Cells(lngZeile, 1).Value = wksEingabe.Range("D2").Value
.Cells(lngZeile, 2).Value = wksEingabe.Range("E2").Value
.Cells(lngZeile, 3).Value = wksEingabe.Range("F2").Value
.Cells(lngZeile, 4).Value = wksEingabe.Range("G2").Value
.Cells(lngZeile, 5).Value = wksEingabe.Range("H2").Value
.Cells(lngZeile, 6).Value = wksEingabe.Range("I2").Value
.Cells(lngZeile, 7).Value = wksEingabe.Range("J2").Value
.Cells(lngZeile, 8).Value = wksEingabe.Range("K2").Value
.Cells(lngZeile, 9).Value = wksEingabe.Range("L2").Value
.Cells(lngZeile, 10).Value = wksEingabe.Range("M2").Value
.Cells(lngZeile, 11).Value = wksEingabe.Range("N2").Value
.Cells(lngZeile, 12).Value = wksEingabe.Range("O2").Value
.Cells(lngZeile, 13).Value = wksEingabe.Range("P2").Value
.Cells(lngZeile, 14).Value = wksEingabe.Range("Q2").Value
.Cells(lngZeile, 15).Value = wksEingabe.Range("R2").Value
.Cells(lngZeile, 16).Value = wksEingabe.Range("S2").Value
.Cells(lngZeile, 17).Value = wksEingabe.Range("T2").Value
.Cells(lngZeile, 18).Value = wksEingabe.Range("U2").Value
.Cells(lngZeile, 19).Value = wksEingabe.Range("V2").Value
.Cells(lngZeile, 20).Value = wksEingabe.Range("W2").Value
.Cells(lngZeile, 21).Value = wksEingabe.Range("X2").Value
.Cells(lngZeile, 22).Value = wksEingabe.Range("Y2").Value
.Cells(lngZeile, 23).Value = wksEingabe.Range("Z2").Value
.Cells(lngZeile, 24).Value = wksEingabe.Range("AA2").Value
.Cells(lngZeile, 25).Value = wksEingabe.Range("AB2").Value
.Cells(lngZeile, 26).Value = wksEingabe.Range("AC2").Value
.Cells(lngZeile, 27).Value = wksEingabe.Range("AD2").Value
.Cells(lngZeile, 28).Value = wksEingabe.Range("AE2").Value
.Cells(lngZeile, 29).Value = wksEingabe.Range("AF2").Value
.Cells(lngZeile, 30).Value = wksEingabe.Range("AG2").Value
.Cells(lngZeile, 31).Value = wksEingabe.Range("AH2").Value
.Cells(lngZeile, 32).Value = wksEingabe.Range("AI2").Value
.Cells(lngZeile, 33).Value = wksEingabe.Range("AJ2").Value
.Cells(lngZeile, 34).Value = wksEingabe.Range("AK2").Value
.Cells(lngZeile, 35).Value = wksEingabe.Range("AL2").Value
.Cells(lngZeile, 36).Value = wksEingabe.Range("AM2").Value
.Cells(lngZeile, 37).Value = wksEingabe.Range("AN2").Value
.Cells(lngZeile, 38).Value = wksEingabe.Range("AO2").Value
.Cells(lngZeile, 39).Value = wksEingabe.Range("AP2").Value
.Cells(lngZeile, 40).Value = wksEingabe.Range("AQ2").Value
.Cells(lngZeile, 41).Value = wksEingabe.Range("AR2").Value
.Cells(lngZeile, 42).Value = wksEingabe.Range("AS2").Value
.Cells(lngZeile, 43).Value = wksEingabe.Range("AT2").Value
.Cells(lngZeile, 44).Value = wksEingabe.Range("AU2").Value
.Cells(lngZeile, 45).Value = wksEingabe.Range("AV2").Value
.Cells(lngZeile, 46).Value = wksEingabe.Range("AW2").Value
.Cells(lngZeile, 47).Value = wksEingabe.Range("AX2").Value
.Cells(lngZeile, 48).Value = wksEingabe.Range("AY2").Value
.Cells(lngZeile, 49).Value = wksEingabe.Range("AZ2").Value
.Cells(lngZeile, 50).Value = wksEingabe.Range("BA2").Value
.Cells(lngZeile, 51).Value = wksEingabe.Range("BB2").Value
.Cells(lngZeile, 52).Value = wksEingabe.Range("BC2").Value
.Cells(lngZeile, 53).Value = wksEingabe.Range("BD2").Value
.Cells(lngZeile, 54).Value = wksEingabe.Range("BE2").Value
.Cells(lngZeile, 55).Value = wksEingabe.Range("BF2").Value
.Cells(lngZeile, 56).Value = wksEingabe.Range("BG2").Value
.Cells(lngZeile, 57).Value = wksEingabe.Range("BH2").Value
.Cells(lngZeile, 58).Value = wksEingabe.Range("BI2").Value
.Cells(lngZeile, 59).Value = wksEingabe.Range("BJ2").Value
.Cells(lngZeile, 60).Value = wksEingabe.Range("BK2").Value
.Cells(lngZeile, 61).Value = wksEingabe.Range("BL2").Value
.Cells(lngZeile, 62).Value = wksEingabe.Range("BM2").Value
.Cells(lngZeile, 63).Value = wksEingabe.Range("BN2").Value
.Cells(lngZeile, 64).Value = wksEingabe.Range("BO2").Value
.Cells(lngZeile, 65).Value = wksEingabe.Range("BP2").Value
.Cells(lngZeile, 66).Value = wksEingabe.Range("BQ2").Value
.Cells(lngZeile, 67).Value = wksEingabe.Range("BR2").Value
.Cells(lngZeile, 68).Value = wksEingabe.Range("BS2").Value
.Cells(lngZeile, 69).Value = wksEingabe.Range("BT2").Value
.Cells(lngZeile, 70).Value = wksEingabe.Range("BU2").Value
.Cells(lngZeile, 71).Value = wksEingabe.Range("BV2").Value
.Cells(lngZeile, 72).Value = wksEingabe.Range("BW2").Value
.Cells(lngZeile, 73).Value = wksEingabe.Range("BX2").Value
.Cells(lngZeile, 74).Value = wksEingabe.Range("BY2").Value
.Cells(lngZeile, 75).Value = wksEingabe.Range("BZ2").Value
.Cells(lngZeile, 76).Value = wksEingabe.Range("CA2").Value
.Cells(lngZeile, 77).Value = wksEingabe.Range("CB2").Value
.Cells(lngZeile, 78).Value = wksEingabe.Range("CC2").Value
.Cells(lngZeile, 79).Value = wksEingabe.Range("CD2").Value
.Cells(lngZeile, 80).Value = wksEingabe.Range("CE2").Value
.Cells(lngZeile, 81).Value = wksEingabe.Range("CF2").Value
.Cells(lngZeile, 82).Value = wksEingabe.Range("CG2").Value
.Cells(lngZeile, 83).Value = wksEingabe.Range("CH2").Value
.Cells(lngZeile, 84).Value = wksEingabe.Range("CI2").Value
.Cells(lngZeile, 85).Value = wksEingabe.Range("CJ2").Value
.Cells(lngZeile, 86).Value = wksEingabe.Range("CK2").Value
.Cells(lngZeile, 87).Value = wksEingabe.Range("CL2").Value
.Cells(lngZeile, 88).Value = wksEingabe.Range("CM2").Value
.Cells(lngZeile, 89).Value = wksEingabe.Range("CN2").Value
.Cells(lngZeile, 90).Value = wksEingabe.Range("CO2").Value
.Cells(lngZeile, 91).Value = wksEingabe.Range("CP2").Value
.Cells(lngZeile, 92).Value = wksEingabe.Range("CQ2").Value
.Cells(lngZeile, 93).Value = wksEingabe.Range("CR2").Value
.Cells(lngZeile, 94).Value = wksEingabe.Range("CS2").Value
.Cells(lngZeile, 95).Value = wksEingabe.Range("CT2").Value
.Cells(lngZeile, 96).Value = wksEingabe.Range("CU2").Value
.Cells(lngZeile, 97).Value = wksEingabe.Range("CV2").Value
.Cells(lngZeile, 98).Value = wksEingabe.Range("CW2").Value
.Cells(lngZeile, 99).Value = wksEingabe.Range("CX2").Value
.Cells(lngZeile, 100).Value = wksEingabe.Range("CY2").Value
.Cells(lngZeile, 101).Value = wksEingabe.Range("CZ2").Value
.Cells(lngZeile, 102).Value = wksEingabe.Range("DA2").Value
.Cells(lngZeile, 103).Value = wksEingabe.Range("DB2").Value
.Cells(lngZeile, 104).Value = wksEingabe.Range("DC2").Value
.Cells(lngZeile, 105).Value = wksEingabe.Range("DD2").Value
.Cells(lngZeile, 106).Value = wksEingabe.Range("DE2").Value
.Cells(lngZeile, 107).Value = wksEingabe.Range("DF2").Value
.Cells(lngZeile, 108).Value = wksEingabe.Range("DG2").Value
.Cells(lngZeile, 109).Value = wksEingabe.Range("DH2").Value
.Cells(lngZeile, 110).Value = wksEingabe.Range("DI2").Value
.Cells(lngZeile, 111).Value = wksEingabe.Range("DJ2").Value
.Cells(lngZeile, 112).Value = wksEingabe.Range("DK2").Value
.Cells(lngZeile, 113).Value = wksEingabe.Range("DL2").Value
.Cells(lngZeile, 114).Value = wksEingabe.Range("DM2").Value
.Cells(lngZeile, 115).Value = wksEingabe.Range("DN2").Value
.Cells(lngZeile, 116).Value = wksEingabe.Range("DO2").Value
.Cells(lngZeile, 117).Value = wksEingabe.Range("DP2").Value
.Cells(lngZeile, 118).Value = wksEingabe.Range("DQ2").Value
.Cells(lngZeile, 119).Value = wksEingabe.Range("DR2").Value
.Cells(lngZeile, 120).Value = wksEingabe.Range("DS2").Value
.Cells(lngZeile, 121).Value = wksEingabe.Range("DT2").Value
.Cells(lngZeile, 122).Value = wksEingabe.Range("DU2").Value
.Cells(lngZeile, 123).Value = wksEingabe.Range("DV2").Value
.Cells(lngZeile, 124).Value = wksEingabe.Range("DW2").Value
.Cells(lngZeile, 125).Value = wksEingabe.Range("DX2").Value
.Cells(lngZeile, 126).Value = wksEingabe.Range("DY2").Value
.Cells(lngZeile, 127).Value = wksEingabe.Range("DZ2").Value
.Cells(lngZeile, 128).Value = wksEingabe.Range("EA2").Value
.Cells(lngZeile, 129).Value = wksEingabe.Range("EB2").Value
.Cells(lngZeile, 130).Value = wksEingabe.Range("EC2").Value
.Cells(lngZeile, 131).Value = wksEingabe.Range("ED2").Value
.Cells(lngZeile, 132).Value = wksEingabe.Range("EE2").Value
.Cells(lngZeile, 133).Value = wksEingabe.Range("EF2").Value
.Cells(lngZeile, 134).Value = wksEingabe.Range("EG2").Value
.Cells(lngZeile, 135).Value = wksEingabe.Range("EH2").Value
.Cells(lngZeile, 136).Value = wksEingabe.Range("EI2").Value
.Cells(lngZeile, 137).Value = wksEingabe.Range("EJ2").Value
.Cells(lngZeile, 138).Value = wksEingabe.Range("EK2").Value
.Cells(lngZeile, 139).Value = wksEingabe.Range("EL2").Value
.Cells(lngZeile, 140).Value = wksEingabe.Range("EM2").Value
.Cells(lngZeile, 141).Value = wksEingabe.Range("EN2").Value
.Cells(lngZeile, 142).Value = wksEingabe.Range("EO2").Value
.Cells(lngZeile, 143).Value = wksEingabe.Range("EP2").Value
.Cells(lngZeile, 144).Value = wksEingabe.Range("EQ2").Value
.Cells(lngZeile, 145).Value = wksEingabe.Range("ER2").Value
.Cells(lngZeile, 146).Value = wksEingabe.Range("ES2").Value
.Cells(lngZeile, 147).Value = wksEingabe.Range("ET2").Value
.Cells(lngZeile, 148).Value = wksEingabe.Range("EU2").Value
.Cells(lngZeile, 149).Value = wksEingabe.Range("EV2").Value
.Cells(lngZeile, 150).Value = wksEingabe.Range("EW2").Value
'Schichtbezogene Daten Ende
'usw.
End With
End Sub

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Optimierung
28.12.2015 18:44:35
Beverly
Hi,
schreibe stattdessen
    wksEingabe.Range("D2:EW2").Copy .Cells(lngZeile, 1)

Damit wird der gesamte Bereich auf einen Ritt kopiert.


AW: Makro Optimierung
30.12.2015 11:41:51
Lutz
Hallo Karin,
schon einmal besten Dank.
Es hat so weit schon einmal funktioniert.
Da in den kopierten Zellen, allerdings SVERWEISE drin stehen mache ich mich jetzt mal auf die Suche wo ich die Umwandlung in Werte (.value) einfügen muss.
Ich habe meinen Code jetzt nach deinen Ideen stark verkürzt und er sieht so aus:
Sub Auswertung_nach_Kunden_1()
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
Dim lngZeile As Long, rngZelle As Range
Set wksEingabe = Worksheets("AW_nach_runid")  'Eingabetabellenblatt
Set wksListe = Worksheets("Auswertung_nach_Kd")      'Tabellenblatt in das die Daten  _
geschrieben werden _
sollen
With wksListe
'nächste freie Zeile in Liste
Set rngZelle = .Cells.Find(What:="*", after:=.Range("A1"), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
lngZeile = 1
Else
lngZeile = rngZelle.Row + 1
End If
'Spalte A - automatisch Nummerieren
wksEingabe.Range("D2:EW2").Copy .Cells(lngZeile, 1)
'Schichtbezogene Daten Ende
'usw.
End With
End Sub

Folgende ergänzende Frage ergibt sich noch:
Ich lasse den Code jetzt praktisch 10 x über Call nacheinander laufen, allerdings mit folgenden Änderungen:
wksEingabe.Range("D2:EW2").Copy .Cells(lngZeile, 1)
wksEingabe.Range("D3:EW3").Copy .Cells(lngZeile, 1)
wksEingabe.Range("D4:EW4").Copy .Cells(lngZeile, 1)
...
wksEingabe.Range("D11:EW11").Copy .Cells(lngZeile, 1)
Ab und an ist eine Zeile leer - dann schreibt er lt. meinem Verständnis in die "Auswertung_nach_Kd" eine leere Zeile.
Beim nächsten Eintrag sucht er aber richtigerweise immer wieder nach der 1. leeren Zeile in der "Auswertung_nach_Kd" und beginnt dort auf das neue...
Sollte / Kann man das auch optimieren und wenn ja kannst du mich in eine Richtung schubsen.
Besten Dank :-)

Anzeige
AW: Makro Optimierung
30.12.2015 12:17:52
Beverly
Hi,
wenn von Zeile 2 bis 11 kopiert werden soll, dann kannst du doch eine Schleife benutzen:
    Dim lngZaehler As Long
For lngZaehler = 2 To 11
' prüfen ob Bereich leer ist
If Application.CountA(wksEingabe.Range("D" & lngZaehler & ":EW" & lngZaehler))  0  _
Then
' laufende Zeile kopieren
wksEingabe.Range("D" & lngZaehler & ":EW" & lngZaehler).Copy
' nur Werte einfügen
.Cells(lngZeile, 1).PasteSpecial Paste:=xlValues
lngZeile = lngZeile + 1
End If
Next lngZaehler


Anzeige
AW: Makro Optimierung
30.12.2015 12:54:47
Lutz
:-) Du bist ja Wahnsinn :-)
Das funktioniert. Und die Geschwindigkeit ...yipppieh
Was er dabei noch macht:
Zur besseren Übersicht habe ich in dem Eingabeblatt die ersten 5 Spalten grau unterlegt.
- Kann ich das unterbinden das er den Zellhintergrund mit übernimmt?
- Warum springt er jetzt zwischen den Fenstern hin / und her - ich kann praktisch Live verfolgen wie er einträgt - kann man das in den Hintergrund "verschieben"
- Damit ich es zukünftig verstehe, was in deinem Code definiert denn jetzt das er die Werte überträgt und nicht die Formel?
Hier mein aktualisierter Code:
Sub Auswertung_new()
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
Dim lngZeile As Long, rngZelle As Range
Set wksEingabe = Worksheets("AW_nach_runid")  'Eingabetabellenblatt
Set wksListe = Worksheets("Auswertung_nach_Kd")      'Tabellenblatt in das die Daten  _
geschrieben werden _
sollen
With wksListe
'nächste freie Zeile in Liste
Set rngZelle = .Cells.Find(What:="*", after:=.Range("A1"), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
lngZeile = 1
Else
lngZeile = rngZelle.Row + 1
End If
'Spalte A - automatisch Nummerieren
Dim lngZaehler As Long
For lngZaehler = 2 To 11
' prüfen ob Bereich leer ist
If Application.CountA(wksEingabe.Range("D" & lngZaehler & ":EW" & lngZaehler))  0 _
Then
' laufende Zeile kopieren
wksEingabe.Range("D" & lngZaehler & ":EW" & lngZaehler).Copy
' nur Werte einfügen
.Cells(lngZeile, 1).PasteSpecial Paste:=xlValues
lngZeile = lngZeile + 1
End If
Next lngZaehler
'Schichtbezogene Daten Ende
'usw.
End With
End Sub
Da ich neu hier bin, kann man sich irgendwie erkenntlich zeigen bei den Hilfeleistenden?

Anzeige
AW: Makro Optimierung
30.12.2015 15:51:50
Beverly
Du kannst noch die Bildschirmaktualisierung ausschalten, damit das Kopieren nicht sichtbar ist:
    Dim lngZaehler As Long
Application.ScreenUpdating = False
For lngZaehler = 2 To 11
' prüfen ob Bereich leer ist
If Application.CountA(wksEingabe.Range("D" & lngZaehler & ":EW" & lngZaehler))  0 _
Then
' laufende Zeile kopieren
wksEingabe.Range("D" & lngZaehler & ":EW" & lngZaehler).Copy
' nur Werte einfügen
.Cells(lngZeile, 1).PasteSpecial Paste:=xlValues
lngZeile = lngZeile + 1
End If
Next lngZaehler
Application.ScreenUpdating = True
Application.CutCopyMode = False



Anzeige
AW: Makro Optimierung
30.12.2015 16:31:54
Lutz
Vielen Dank - so ähnlich hatte ich es durch selber googlen schon, aber dank dir läuft es jetzt auch prima. Ebenfalls dank deine Fachbegriffe und googlen konnte ich weitere Dinge vereinfachen. :-)
Lieben Dank dafür schon mal...
Zeitnah werde ich mich dann auch an die Vereinfachung von folgendem Code machen.
Falls es dafür ein paar Ansätze gibt würde ich mich freuen.
Für alle die hier Hilfestellungen geben und in dem Fall insbesondere an dich Karin - "Herzlichen Dank",
das erspart mir bei der Berichterstattung gegenüber der Chefetage und dem Innendienst immense Arbeit (Dank Excel- und Berichtswesenschikane). Und wenn ich die Ladezeiten etc. optimiert habe, werde ich dann auch meine Außendienstkollegen glücklich machen und denen das Tool zur Verfügung stellen...
Gesundes und Erfolgreiches 2016 :-)
Sub Schichtbericht_Neu_Erfassung_Schicht1()
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
Dim lngZeile As Long, rngZelle As Range
Set wksEingabe = Worksheets("Schichtbericht_Schicht1")  'Eingabetabellenblatt
Set wksListe = Worksheets("Auswertung")      'Tabellenblatt in das die Daten geschrieben  _
werden _
sollen
With wksListe
'nächste freie Zeile in Liste
Set rngZelle = .Cells.Find(What:="*", after:=.Range("A1"), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
lngZeile = 1
Else
lngZeile = rngZelle.Row + 1
End If
'Spalte A - automatisch Nummerieren
.Cells(lngZeile, 1).Value = Application.WorksheetFunction.Max(.Columns(1)) + 1
'Value definiert den Wert zu übernehmen
'Kopfdaten start
.Cells(lngZeile, 2).Value = wksEingabe.Range("C1").Value
.Cells(lngZeile, 3).Value = wksEingabe.Range("G1").Value
.Cells(lngZeile, 4).Value = wksEingabe.Range("B1").Value
.Cells(lngZeile, 5).Value = wksEingabe.Range("A40").Value
.Cells(lngZeile, 6).Value = wksEingabe.Range("B13").Value
.Cells(lngZeile, 7).Value = wksEingabe.Range("AG13").Value
.Cells(lngZeile, 8).Value = wksEingabe.Range("C13").Value
.Cells(lngZeile, 9).Value = wksEingabe.Range("D13").Value
.Cells(lngZeile, 10).Value = wksEingabe.Range("B14").Value
.Cells(lngZeile, 11).Value = wksEingabe.Range("AG14").Value
.Cells(lngZeile, 12).Value = wksEingabe.Range("C14").Value
.Cells(lngZeile, 13).Value = wksEingabe.Range("D14").Value
.Cells(lngZeile, 14).Value = wksEingabe.Range("B15").Value
.Cells(lngZeile, 15).Value = wksEingabe.Range("AG15").Value
.Cells(lngZeile, 16).Value = wksEingabe.Range("C15").Value
.Cells(lngZeile, 17).Value = wksEingabe.Range("D15").Value
.Cells(lngZeile, 18).Value = wksEingabe.Range("B16").Value
.Cells(lngZeile, 19).Value = wksEingabe.Range("AG16").Value
.Cells(lngZeile, 20).Value = wksEingabe.Range("C16").Value
.Cells(lngZeile, 21).Value = wksEingabe.Range("D16").Value
.Cells(lngZeile, 22).Value = wksEingabe.Range("B17").Value
.Cells(lngZeile, 23).Value = wksEingabe.Range("AG17").Value
.Cells(lngZeile, 24).Value = wksEingabe.Range("C17").Value
.Cells(lngZeile, 25).Value = wksEingabe.Range("D17").Value
.Cells(lngZeile, 26).Value = wksEingabe.Range("B18").Value
.Cells(lngZeile, 27).Value = wksEingabe.Range("AG18").Value
.Cells(lngZeile, 28).Value = wksEingabe.Range("C18").Value
.Cells(lngZeile, 29).Value = wksEingabe.Range("D18").Value
.Cells(lngZeile, 30).Value = wksEingabe.Range("B19").Value
.Cells(lngZeile, 31).Value = wksEingabe.Range("AG19").Value
.Cells(lngZeile, 32).Value = wksEingabe.Range("C19").Value
.Cells(lngZeile, 33).Value = wksEingabe.Range("D19").Value
.Cells(lngZeile, 34).Value = wksEingabe.Range("B20").Value
.Cells(lngZeile, 35).Value = wksEingabe.Range("AG20").Value
.Cells(lngZeile, 36).Value = wksEingabe.Range("C20").Value
.Cells(lngZeile, 37).Value = wksEingabe.Range("D20").Value
.Cells(lngZeile, 38).Value = wksEingabe.Range("B21").Value
.Cells(lngZeile, 39).Value = wksEingabe.Range("AG21").Value
.Cells(lngZeile, 40).Value = wksEingabe.Range("C21").Value
.Cells(lngZeile, 41).Value = wksEingabe.Range("D21").Value
.Cells(lngZeile, 42).Value = wksEingabe.Range("B22").Value
.Cells(lngZeile, 43).Value = wksEingabe.Range("AG22").Value
.Cells(lngZeile, 44).Value = wksEingabe.Range("C22").Value
.Cells(lngZeile, 45).Value = wksEingabe.Range("D22").Value
.Cells(lngZeile, 46).Value = wksEingabe.Range("A26").Value
.Cells(lngZeile, 47).Value = wksEingabe.Range("A27").Value
.Cells(lngZeile, 48).Value = wksEingabe.Range("A28").Value
.Cells(lngZeile, 49).Value = wksEingabe.Range("A29").Value
.Cells(lngZeile, 50).Value = wksEingabe.Range("A30").Value
.Cells(lngZeile, 723).Value = wksEingabe.Range("D40").Value
'Kopfdaten Ende
'Schichtbezogene Daten
.Cells(lngZeile, 51).Value = wksEingabe.Range("M13").Value
.Cells(lngZeile, 52).Value = wksEingabe.Range("N13").Value
.Cells(lngZeile, 53).Value = wksEingabe.Range("O13").Value
.Cells(lngZeile, 54).Value = wksEingabe.Range("P13").Value
.Cells(lngZeile, 55).Value = wksEingabe.Range("Q13").Value
.Cells(lngZeile, 56).Value = wksEingabe.Range("R13").Value
.Cells(lngZeile, 57).Value = wksEingabe.Range("T13").Value
.Cells(lngZeile, 58).Value = wksEingabe.Range("M14").Value
.Cells(lngZeile, 59).Value = wksEingabe.Range("N14").Value
.Cells(lngZeile, 60).Value = wksEingabe.Range("O14").Value
.Cells(lngZeile, 61).Value = wksEingabe.Range("P14").Value
.Cells(lngZeile, 62).Value = wksEingabe.Range("Q14").Value
.Cells(lngZeile, 63).Value = wksEingabe.Range("R14").Value
.Cells(lngZeile, 64).Value = wksEingabe.Range("T14").Value
.Cells(lngZeile, 65).Value = wksEingabe.Range("M15").Value
.Cells(lngZeile, 66).Value = wksEingabe.Range("N15").Value
.Cells(lngZeile, 67).Value = wksEingabe.Range("O15").Value
.Cells(lngZeile, 68).Value = wksEingabe.Range("P15").Value
.Cells(lngZeile, 69).Value = wksEingabe.Range("Q15").Value
.Cells(lngZeile, 70).Value = wksEingabe.Range("R15").Value
.Cells(lngZeile, 71).Value = wksEingabe.Range("T15").Value
.Cells(lngZeile, 72).Value = wksEingabe.Range("M16").Value
.Cells(lngZeile, 73).Value = wksEingabe.Range("N16").Value
.Cells(lngZeile, 74).Value = wksEingabe.Range("O16").Value
.Cells(lngZeile, 75).Value = wksEingabe.Range("P16").Value
.Cells(lngZeile, 76).Value = wksEingabe.Range("Q16").Value
.Cells(lngZeile, 77).Value = wksEingabe.Range("R16").Value
.Cells(lngZeile, 78).Value = wksEingabe.Range("T16").Value
.Cells(lngZeile, 79).Value = wksEingabe.Range("M17").Value
.Cells(lngZeile, 80).Value = wksEingabe.Range("N17").Value
.Cells(lngZeile, 81).Value = wksEingabe.Range("O17").Value
.Cells(lngZeile, 82).Value = wksEingabe.Range("P17").Value
.Cells(lngZeile, 83).Value = wksEingabe.Range("Q17").Value
.Cells(lngZeile, 84).Value = wksEingabe.Range("R17").Value
.Cells(lngZeile, 85).Value = wksEingabe.Range("T17").Value
.Cells(lngZeile, 86).Value = wksEingabe.Range("M18").Value
.Cells(lngZeile, 87).Value = wksEingabe.Range("N18").Value
.Cells(lngZeile, 88).Value = wksEingabe.Range("O18").Value
.Cells(lngZeile, 89).Value = wksEingabe.Range("P18").Value
.Cells(lngZeile, 90).Value = wksEingabe.Range("Q18").Value
.Cells(lngZeile, 91).Value = wksEingabe.Range("R18").Value
.Cells(lngZeile, 92).Value = wksEingabe.Range("T18").Value
.Cells(lngZeile, 93).Value = wksEingabe.Range("M19").Value
.Cells(lngZeile, 94).Value = wksEingabe.Range("N19").Value
.Cells(lngZeile, 95).Value = wksEingabe.Range("O19").Value
.Cells(lngZeile, 96).Value = wksEingabe.Range("P19").Value
.Cells(lngZeile, 97).Value = wksEingabe.Range("Q19").Value
.Cells(lngZeile, 98).Value = wksEingabe.Range("R19").Value
.Cells(lngZeile, 99).Value = wksEingabe.Range("T19").Value
.Cells(lngZeile, 100).Value = wksEingabe.Range("M20").Value
.Cells(lngZeile, 101).Value = wksEingabe.Range("N20").Value
.Cells(lngZeile, 102).Value = wksEingabe.Range("O20").Value
.Cells(lngZeile, 103).Value = wksEingabe.Range("P20").Value
.Cells(lngZeile, 104).Value = wksEingabe.Range("Q20").Value
.Cells(lngZeile, 105).Value = wksEingabe.Range("R20").Value
.Cells(lngZeile, 106).Value = wksEingabe.Range("T20").Value
.Cells(lngZeile, 107).Value = wksEingabe.Range("M21").Value
.Cells(lngZeile, 108).Value = wksEingabe.Range("N21").Value
.Cells(lngZeile, 109).Value = wksEingabe.Range("O21").Value
.Cells(lngZeile, 110).Value = wksEingabe.Range("P21").Value
.Cells(lngZeile, 111).Value = wksEingabe.Range("Q21").Value
.Cells(lngZeile, 112).Value = wksEingabe.Range("R21").Value
.Cells(lngZeile, 113).Value = wksEingabe.Range("T21").Value
.Cells(lngZeile, 114).Value = wksEingabe.Range("M22").Value
.Cells(lngZeile, 115).Value = wksEingabe.Range("N22").Value
.Cells(lngZeile, 116).Value = wksEingabe.Range("O22").Value
.Cells(lngZeile, 117).Value = wksEingabe.Range("P22").Value
.Cells(lngZeile, 118).Value = wksEingabe.Range("Q22").Value
.Cells(lngZeile, 119).Value = wksEingabe.Range("R22").Value
.Cells(lngZeile, 120).Value = wksEingabe.Range("T22").Value
.Cells(lngZeile, 121).Value = wksEingabe.Range("M23").Value
.Cells(lngZeile, 122).Value = wksEingabe.Range("N23").Value
.Cells(lngZeile, 123).Value = wksEingabe.Range("O23").Value
.Cells(lngZeile, 124).Value = wksEingabe.Range("P23").Value
.Cells(lngZeile, 125).Value = wksEingabe.Range("Q23").Value
.Cells(lngZeile, 126).Value = wksEingabe.Range("R23").Value
.Cells(lngZeile, 127).Value = wksEingabe.Range("T23").Value
.Cells(lngZeile, 128).Value = wksEingabe.Range("M24").Value
.Cells(lngZeile, 129).Value = wksEingabe.Range("N24").Value
.Cells(lngZeile, 130).Value = wksEingabe.Range("O24").Value
.Cells(lngZeile, 131).Value = wksEingabe.Range("P24").Value
.Cells(lngZeile, 132).Value = wksEingabe.Range("Q24").Value
.Cells(lngZeile, 133).Value = wksEingabe.Range("R24").Value
.Cells(lngZeile, 134).Value = wksEingabe.Range("T24").Value
.Cells(lngZeile, 135).Value = wksEingabe.Range("M25").Value
.Cells(lngZeile, 136).Value = wksEingabe.Range("N25").Value
.Cells(lngZeile, 137).Value = wksEingabe.Range("O25").Value
.Cells(lngZeile, 138).Value = wksEingabe.Range("P25").Value
.Cells(lngZeile, 139).Value = wksEingabe.Range("Q25").Value
.Cells(lngZeile, 140).Value = wksEingabe.Range("R25").Value
.Cells(lngZeile, 141).Value = wksEingabe.Range("T25").Value
.Cells(lngZeile, 142).Value = wksEingabe.Range("M26").Value
.Cells(lngZeile, 143).Value = wksEingabe.Range("N26").Value
.Cells(lngZeile, 144).Value = wksEingabe.Range("O26").Value
.Cells(lngZeile, 145).Value = wksEingabe.Range("P26").Value
.Cells(lngZeile, 146).Value = wksEingabe.Range("Q26").Value
.Cells(lngZeile, 147).Value = wksEingabe.Range("R26").Value
.Cells(lngZeile, 148).Value = wksEingabe.Range("T26").Value
.Cells(lngZeile, 149).Value = wksEingabe.Range("M27").Value
.Cells(lngZeile, 150).Value = wksEingabe.Range("N27").Value
.Cells(lngZeile, 151).Value = wksEingabe.Range("O27").Value
.Cells(lngZeile, 152).Value = wksEingabe.Range("P27").Value
.Cells(lngZeile, 153).Value = wksEingabe.Range("Q27").Value
.Cells(lngZeile, 154).Value = wksEingabe.Range("R27").Value
.Cells(lngZeile, 155).Value = wksEingabe.Range("T27").Value
.Cells(lngZeile, 156).Value = wksEingabe.Range("M28").Value
.Cells(lngZeile, 157).Value = wksEingabe.Range("N28").Value
.Cells(lngZeile, 158).Value = wksEingabe.Range("O28").Value
.Cells(lngZeile, 159).Value = wksEingabe.Range("P28").Value
.Cells(lngZeile, 160).Value = wksEingabe.Range("Q28").Value
.Cells(lngZeile, 161).Value = wksEingabe.Range("R28").Value
.Cells(lngZeile, 162).Value = wksEingabe.Range("T28").Value
.Cells(lngZeile, 163).Value = wksEingabe.Range("M29").Value
.Cells(lngZeile, 164).Value = wksEingabe.Range("N29").Value
.Cells(lngZeile, 165).Value = wksEingabe.Range("O29").Value
.Cells(lngZeile, 166).Value = wksEingabe.Range("P29").Value
.Cells(lngZeile, 167).Value = wksEingabe.Range("Q29").Value
.Cells(lngZeile, 168).Value = wksEingabe.Range("R29").Value
.Cells(lngZeile, 169).Value = wksEingabe.Range("T29").Value
.Cells(lngZeile, 170).Value = wksEingabe.Range("M30").Value
.Cells(lngZeile, 171).Value = wksEingabe.Range("N30").Value
.Cells(lngZeile, 172).Value = wksEingabe.Range("O30").Value
.Cells(lngZeile, 173).Value = wksEingabe.Range("P30").Value
.Cells(lngZeile, 174).Value = wksEingabe.Range("Q30").Value
.Cells(lngZeile, 175).Value = wksEingabe.Range("R30").Value
.Cells(lngZeile, 176).Value = wksEingabe.Range("T30").Value
.Cells(lngZeile, 177).Value = wksEingabe.Range("M31").Value
.Cells(lngZeile, 178).Value = wksEingabe.Range("N31").Value
.Cells(lngZeile, 179).Value = wksEingabe.Range("O31").Value
.Cells(lngZeile, 180).Value = wksEingabe.Range("P31").Value
.Cells(lngZeile, 181).Value = wksEingabe.Range("Q31").Value
.Cells(lngZeile, 182).Value = wksEingabe.Range("R31").Value
.Cells(lngZeile, 183).Value = wksEingabe.Range("T31").Value
.Cells(lngZeile, 184).Value = wksEingabe.Range("M32").Value
.Cells(lngZeile, 185).Value = wksEingabe.Range("N32").Value
.Cells(lngZeile, 186).Value = wksEingabe.Range("O32").Value
.Cells(lngZeile, 187).Value = wksEingabe.Range("P32").Value
.Cells(lngZeile, 188).Value = wksEingabe.Range("Q32").Value
.Cells(lngZeile, 189).Value = wksEingabe.Range("R32").Value
.Cells(lngZeile, 190).Value = wksEingabe.Range("T32").Value
.Cells(lngZeile, 191).Value = wksEingabe.Range("M33").Value
.Cells(lngZeile, 192).Value = wksEingabe.Range("N33").Value
.Cells(lngZeile, 193).Value = wksEingabe.Range("O33").Value
.Cells(lngZeile, 194).Value = wksEingabe.Range("P33").Value
.Cells(lngZeile, 195).Value = wksEingabe.Range("Q33").Value
.Cells(lngZeile, 196).Value = wksEingabe.Range("R33").Value
.Cells(lngZeile, 197).Value = wksEingabe.Range("T33").Value
.Cells(lngZeile, 198).Value = wksEingabe.Range("M34").Value
.Cells(lngZeile, 199).Value = wksEingabe.Range("N34").Value
.Cells(lngZeile, 200).Value = wksEingabe.Range("O34").Value
.Cells(lngZeile, 201).Value = wksEingabe.Range("P34").Value
.Cells(lngZeile, 202).Value = wksEingabe.Range("Q34").Value
.Cells(lngZeile, 203).Value = wksEingabe.Range("R34").Value
.Cells(lngZeile, 204).Value = wksEingabe.Range("T34").Value
.Cells(lngZeile, 205).Value = wksEingabe.Range("M35").Value
.Cells(lngZeile, 206).Value = wksEingabe.Range("N35").Value
.Cells(lngZeile, 207).Value = wksEingabe.Range("O35").Value
.Cells(lngZeile, 208).Value = wksEingabe.Range("P35").Value
.Cells(lngZeile, 209).Value = wksEingabe.Range("Q35").Value
.Cells(lngZeile, 210).Value = wksEingabe.Range("R35").Value
.Cells(lngZeile, 211).Value = wksEingabe.Range("T35").Value
.Cells(lngZeile, 212).Value = wksEingabe.Range("M36").Value
.Cells(lngZeile, 213).Value = wksEingabe.Range("N36").Value
.Cells(lngZeile, 214).Value = wksEingabe.Range("O36").Value
.Cells(lngZeile, 215).Value = wksEingabe.Range("P36").Value
.Cells(lngZeile, 216).Value = wksEingabe.Range("Q36").Value
.Cells(lngZeile, 217).Value = wksEingabe.Range("R36").Value
.Cells(lngZeile, 218).Value = wksEingabe.Range("T36").Value
'Schichtbezogene Daten Ende
'usw.
End With
End Sub

Anzeige
AW: Makro Optimierung
30.12.2015 18:54:35
Beverly
Meinst du das vielleicht so:
    'Spalte A - automatisch Nummerieren
.Cells(lngZeile, 1).Value = Application.WorksheetFunction.Max(.Columns(1)) + 1
'Value definiert den Wert zu übernehmen
'Kopfdaten start
.Cells(lngZeile, 2).Value = wksEingabe.Range("C1").Value
.Cells(lngZeile, 3).Value = wksEingabe.Range("G1").Value
.Cells(lngZeile, 4).Value = wksEingabe.Range("B1").Value
.Cells(lngZeile, 5).Value = wksEingabe.Range("A40").Value
Dim intSpalte As Integer
Dim lngAusgang As Long
lngAusgang = 13
For intSpalte = 6 To 50 Step 4
.Cells(lngZeile, intSpalte).Value = wksEingabe.Cells(lngAusgang, 2).Value
.Cells(lngZeile, intSpalte + 1).Value = wksEingabe.Cells(lngAusgang, 33).Value
.Cells(lngZeile, intSpalte + 2).Value = wksEingabe.Cells(lngAusgang, 3).Value
.Cells(lngZeile, intSpalte + 3).Value = wksEingabe.Cells(lngAusgang, 4).Value
lngAusgang = lngAusgang + 1
Next intSpalte
.Cells(lngZeile, 723).Value = wksEingabe.Range("D40").Value
lngAusgang = 13
For intSpalte = 51 To 218 Step 7
.Cells(lngZeile, intSpalte).Resize(, 6) = _
wksEingabe.Range(wksEingabe.Cells(lngAusgang, 13), _
wksEingabe.Cells(lngAusgang, 18)).Value
.Cells(lngZeile, intSpalte + 6) = wksEingabe.Cells(lngAusgang, 20).Value
lngAusgang = lngAusgang + 1
Next intSpalte



Anzeige
AW: Makro Optimierung
05.01.2016 11:39:09
Lutz
Hallo Karin,
zu aller erst ein gesundes und erfolgreiches Jahr 2016.
Ich habe soeben meinen Code durch deinen ersetzt.
1. Phänomenal
2. Die Ladezeiten haben sich bei vollen Protokoll - radikal verkürzt
3. Einfach Danke. Wobei einfach untertrieben ist.
Um zukünftig Änderungen vornehmen zu können, falls mal ein Feld dazukommt versuche ich deinen Code mal auseinanderzunehmen und zu verstehen.
Gibt es etwas was ich von vornherein beachten sollte?
Viele Grüße aus Dresden
Lutz

AW: Makro Optimierung
05.01.2016 12:51:22
Lutz
Hallo, wenn du Lust und Zeit hast kannst du ja mal drüber schauen über meine Auskommentierung ob ich alles richtig verstanden habe und die 1 Frage.
For intSpalte = 6 To 50 Step 4
--> Das bedeutet doch das die Schleife bei 6 startet und bis 50 läuft und aus jeweils 4 Teilschritten besteht? Müsste dann die 50 aber nicht eine 45 sein?
Sub Schichtbericht_Neu_Erfassung_Schicht1()
Dim wksEingabe As Worksheet
Dim wksListe As Worksheet
Dim lngZeile As Long, rngZelle As Range
Set wksEingabe = Worksheets("Schichtbericht_Schicht1")  'Eingabetabellenblatt
Set wksListe = Worksheets("Auswertung")      'Tabellenblatt in das die Daten geschrieben  _
werden _
sollen
With wksListe
'nächste freie Zeile in Liste
Set rngZelle = .Cells.Find(What:="*", after:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If rngZelle Is Nothing Then
lngZeile = 1
Else
lngZeile = rngZelle.Row + 1
End If
'Spalte A - automatisch Nummerieren
.Cells(lngZeile, 1).Value = Application.WorksheetFunction.Max(.Columns(1)) + 1
'Value definiert den Wert zu übernehmen
'Kopfdaten start aus Zeile 1 und Bearbeiter (A40)
.Cells(lngZeile, 2).Value = wksEingabe.Range("C1").Value
.Cells(lngZeile, 3).Value = wksEingabe.Range("G1").Value
.Cells(lngZeile, 4).Value = wksEingabe.Range("B1").Value
.Cells(lngZeile, 5).Value = wksEingabe.Range("A40").Value
Dim intSpalte As Integer
Dim lngAusgang As Long
lngAusgang = 13 'Beginne Zeile 13
For intSpalte = 6 To 50 Step 4      'Fülle die Spalten 6 bis 50
.Cells(lngZeile, intSpalte).Value = wksEingabe.Cells(lngAusgang, 2).Value       'Daten  _
aus 13 B
.Cells(lngZeile, intSpalte + 1).Value = wksEingabe.Cells(lngAusgang, 33).Value  'Daten  _
aus 13 AG
.Cells(lngZeile, intSpalte + 2).Value = wksEingabe.Cells(lngAusgang, 3).Value   'Daten  _
aus 13 C
.Cells(lngZeile, intSpalte + 3).Value = wksEingabe.Cells(lngAusgang, 4).Value   'Daten  _
aus 13 D
lngAusgang = lngAusgang + 1 'Zeile wird hochgezählt
Next intSpalte
.Cells(lngZeile, 723).Value = wksEingabe.Range("D40").Value 'Direkte Übernahme von D40 in  _
Spalte 723
.Cells(lngZeile, 46).Value = wksEingabe.Range("A26").Value  'Direkte Übernahme von A26 in  _
Spalte 46
.Cells(lngZeile, 47).Value = wksEingabe.Range("A27").Value  'Direkte Übernahme von A27 in  _
Spalte 47
.Cells(lngZeile, 48).Value = wksEingabe.Range("A28").Value  'Direkte Übernahme von A28 in  _
Spalte 48
.Cells(lngZeile, 49).Value = wksEingabe.Range("A29").Value  'Direkte Übernahme von A29 in  _
Spalte 49
.Cells(lngZeile, 50).Value = wksEingabe.Range("A30").Value  'Direkte Übernahme von A30 in  _
Spalte 50
lngAusgang = 13
For intSpalte = 51 To 218 Step 7    'Spalte 51 bis 218
.Cells(lngZeile, intSpalte).Resize(, 6) = _
wksEingabe.Range(wksEingabe.Cells(lngAusgang, 13), _
wksEingabe.Cells(lngAusgang, 18)).Value 'Daten von Spalte M - R in betreffender  _
Zeile
.Cells(lngZeile, intSpalte + 6) = wksEingabe.Cells(lngAusgang, 20).Value 'Daten aus  _
Zelle T der betreffenden Zeile
lngAusgang = lngAusgang + 1 'Zeile wird hochgezählt
Next intSpalte
End With
End Sub

Anzeige
AW: Makro Optimierung
30.12.2015 13:01:10
Lutz
Ok den Teil mit den Werten habe ich verstanden :-)
PasteSpecial Paste:=xlValues

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige