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
1396to1400
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 schneller machen

makro schneller machen
05.12.2014 13:01:24
Sarah
Hallo zusammen,
hat jemand vielleicht vorschläge wie ich das nachfolgende makro schneller machen könnte ?
bin froh für jede hilfe
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Integer
Dim i As Integer
Dim zeileaktuell As Integer
Dim zwischenwert As String
Zeile = 2
zeileaktuell = 2
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
Worksheets("Sheet1").Activate
ZeileMax = ActiveSheet.UsedRange.Rows.Count
Range("A1", "K1").Select
Selection.Copy
Sheets("Daten mit Perioden").Select
Range("A1", "K1").Select
ActiveSheet.Paste
Range("H1").FormulaR1C1 = "K/Wert Summe"
Columns("H:H").ColumnWidth = 17.29
Range("J1").FormulaR1C1 = "K/Wert Periode"
For Zeile = 2 To ZeileMax
i = 1
For n = 1 To 12
Worksheets("Sheet1").Activate
Range("A" & Zeile, "I" & Zeile).Select
Selection.Copy
Sheets("Daten mit Perioden").Select
Range("A" & Zeile, "I" & Zeile).Select
ActiveSheet.Range("A" & zeileaktuell, "I" & zeileaktuell).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
Range(Col_Letter(i + 13) & Zeile).Select
Selection.Copy
Sheets("Daten mit Perioden").Select
Range("J" & zeileaktuell).Select
ActiveSheet.Paste
Cells(zeileaktuell, 11).Value = n
zeileaktuell = zeileaktuell + 1
i = i + 1
Next n
Next Zeile
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: makro schneller machen
05.12.2014 13:13:12
Daniel
Hi
zunächsteinmal solltest du dir das selektieren und aktivieren abgewöhnen.
der Recorder zeichnet zwar so auf, weil wir Mausschubser so arbeiten, aber in VBA kann man die Objekte auch direkt ansprechen:
Worksheets("Sheet1").Activate
Range("A" & Zeile, "I" & Zeile).Select
Selection.Copy
Sheets("Daten mit Perioden").Select
Range("A" & Zeile, "I" & Zeile).Select
ActiveSheet.Range("A" & zeileaktuell, "I" & zeileaktuell).Select
ActiveSheet.Paste
kann man so zusammenfassen:
Worksheets("Sheet1").Range("A" & Zeile, "I" & Zeile).Copy
Sheets("Daten mit Perioden").Range("A" & zeileaktuell).PasteSpecial xlPasteAll
damit ist dann auch das Abschalten der Bildschirmaktualisierung nicht mehr notwendig.
weitere Infos dazu hier:
http://www.online-excel.de/excel/singsel_vba.php?f=78
durch diese Umstellung wird der Code nicht nur kürzer, sondern auch übersichlicher und weitere Optiomierungen fallen dir vielleicht selber schneller auf.
Gruß Daniel

Anzeige
AW: makro schneller machen
05.12.2014 13:34:12
UweD
Hallo
auf activate und select kann in den meisten Fällen verzichtet werden.
UNGEPRÜFT wegen fehlender Musterdatei:

Sub Sarah()
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Integer
Dim i As Integer
Dim zeileaktuell As Integer
Dim zwischenwert As String
Zeile = 2
zeileaktuell = 2
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With Worksheets("Sheet1")
ZeileMax = .UsedRange.Rows.Count
.Range("A1", "K1").Copy Sheets("Daten mit Perioden").Range("A1")
.Range("H1").FormulaR1C1 = "K/Wert Summe"
.Columns("H:H").ColumnWidth = 17.29
.Range("J1").FormulaR1C1 = "K/Wert Periode"
For Zeile = 2 To ZeileMax
i = 1
For n = 1 To 12
.Range("A" & Zeile, "I" & Zeile).Copy _
Sheets("Daten mit Perioden").Range("A" & zeileaktuell)
''''.Range(Col_Letter(i + 13) & Zeile).Copy
Sheets("Daten mit Perioden").Range ("J" & zeileaktuell)
''''Unterprogramm Col_Letter?
'direkt die Spalte angeben
.Cells(i + 13, Zeile).Copy Sheets("Daten mit Perioden").Range("A" &  _
zeileaktuell)
.Cells(zeileaktuell, 11).Value = n
zeileaktuell = zeileaktuell + 1
i = i + 1
Next n
Next Zeile
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Gruß UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige