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
1112to1116
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

optimieren

optimieren
René
End SubHallo Ihr Profis,
ich hab da mal zwei Fragen:
Kann man meine Versuche vielleicht schlanker machen und optimieren dass das ganze schneller läuft?
Das speichern der Daten funktioniert irgendwie nicht. Dieser Befehl wird ganz einfach übergangen. Was mache ich da falsch?
Besten Dank schon mal zum voraus für Eure Hilfe.
Freundliche Grüsse
René
Sub daten_uebernahme()
Dim wborig As Workbook, wbziel1 As Workbook, wbziel2 As Workbook
Dim wksorig As Worksheet, wksziel1 As Worksheet, wksziel2 As Worksheet, wksziel3 As Worksheet, zusatz1 As Worksheet, zusatz2 As Worksheet, zusatz3 As Worksheet
Set wborig = Workbooks.Open("d:\vbs\berechnung\Ber_Stat_RT_V3_Grunddaten.xlsm", ReadOnly:=True)
Set wksorig = wborig.Worksheets(1)
Set wbziel1 = Workbooks.Open("D:\VBS\Berechnung\Ber_Stat_RT_V3_Ber1.xlsx", ReadOnly:=False)
Set wksziel1 = wbziel1.Worksheets(1)
Set wksziel2 = wbziel1.Worksheets(2)
Set wksziel3 = wbziel1.Worksheets(3)
Set wbziel2 = Workbooks.Open("d:\vbs\berechnung\Ber_Stat_RT_V3_Zusatz.xlsx", ReadOnly:=False)
Set zusatz1 = wbziel2.Worksheets(1)
Set zusatz2 = wbziel2.Worksheets(2)
Set zusatz3 = wbziel2.Worksheets(3)
'alte daten löschen
'With wbziel
wksziel1.Activate
Rows("2:40000").Select
Selection.Delete shift:=xlUp
Range("A2").Select
wksziel2.Activate
Rows("2:40000").Select
Selection.Delete shift:=xlUp
Range("a2").Select
wksziel3.Activate
Rows("3:40000").Select
Selection.Delete shift:=xlUp
Range("a2").Select
'End With
'daten übertragen
wksorig.Activate
Range("A2:P40000").Select
Selection.Copy
wksziel1.Activate
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A2").Select
'zeichen zoll entfernen
Cells.Replace what:=".1""", replacement:=".1 ", lookat:=xlPart, Searchorder:=xlByRows
Cells.Replace what:=".4""", replacement:=".4 ", lookat:=xlPart, Searchorder:=xlByRows
Cells.Replace what:=".1 ", replacement:=".1 ", lookat:=xlPart, Searchorder:=xlByRows
Cells.Replace what:=".4 ", replacement:=".4 ", lookat:=xlPart, Searchorder:=xlByRows
wksorig.Activate
Application.CutCopyMode = False
Range("a2").Select
'daten für typenkürzung übertragen
wksziel1.Activate
Range("l2:l40000").Select
Selection.Copy
wksziel3.Activate
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
wksziel1.Activate
Application.CutCopyMode = False
Range("a2").Select
wksziel3.Activate
'auto ausfüllen typenkürzung
Range("b2:f2").Select
Selection.AutoFill Destination:=Range("b2:f40000"), Type:=xlFillDefault
'gekürzte typen übertragen
Range("f2:f40000").Select
Selection.Copy
wksziel1.Activate
Range("q2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("a2").Select
wksziel3.Activate
Application.CutCopyMode = False
Range("a2").Select
wksziel1.Activate
Range("a2:q40000").Select
Selection.Copy
wksziel2.Activate
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("a2").Select
wksziel1.Activate
Application.CutCopyMode = False
Range("a2").Select
'duplikate entfernen
wksziel2.Activate
ActiveSheet.Range("$A$1:$P$40000").RemoveDuplicates Columns:=3, Header:= _
xlYes
Range("a2").Select
zusatz1.Activate
Rows("2:40000").Select
Selection.Delete shift:=xlUp
Range("A2").Select
zusatz2.Activate
Rows("2:40000").Select
Selection.Delete shift:=xlUp
Range("A2").Select
zusatz3.Activate
Rows("2:40000").Select
Selection.Delete shift:=xlUp
Range("A2").Select
wksziel1.Activate
Range("a2:b40000 f2:f40000 h2:h40000 m2:o40000 q2:q40000").Select
Selection.Copy
zusatz1.Activate
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("a2").Select
wksziel1.Activate
Range("f2:f40000").Select
Selection.Copy
zusatz1.Activate
Range("c2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("a2").Select
wksziel1.Activate
Range("h2:h40000").Select
Selection.Copy
zusatz1.Activate
Range("d2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("a2").Select
wksziel1.Activate
Range("m2:o40000").Select
Selection.Copy
zusatz1.Activate
Range("e2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("a2").Select
wksziel1.Activate
Application.CutCopyMode = False
Range("a2").Select
wbziel1.Save SaveChanges = True
wbziel1.Close
wbziel2.Save SaveChanges = True
wbziel2.Close
wborig.Close
'ActiveWorkbook.Saved = True diese befehle funtkionieren nicht warum wissen die götter
'ActiveWorkbook.Close
'ActiveWorkbook.Saved = True
'ActiveWorkbook.Close
'ActiveWorkbook.Close

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Save und Close: Parameter
01.11.2009 19:07:03
Erich
Hi René,
Save hat KEINE Parameter, Close wohl.
Alternativ kannst du probieren:

wbziel1.Close SaveChanges:=True
' oder
wbziel1.Save
wbziel1.Close   ' oder wbziel1.Close False
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Save und Close: Parameter
01.11.2009 19:34:33
René
Hallo Erich,
besten Dank für Deine rasche Antwort.
So hat es funktioniert.
Freundliche Grüsse
René
AW: erstmal alle Selects rausschmeissen
01.11.2009 19:23:36
Daniel
HI
als erstes solltest du mal das hier lesen, verstehen und anwenden, dann wird dein Makro sicherlich schon mal ein gutes Stück schneller:
http://www.online-excel.de/excel/singsel_vba.php?f=78
oder, um es kurz zu machen:
diese Zeilen lassen sich in einer zusammenfassen:
wksziel1.Activate
Rows("2:40000").Select
Selection.Delete shift:=xlUp
Range("A2").Select

geht auch so:
wksziel1.Rows("2:40000").Delete shift:=xlUp

das solltest du konsequent durch dein ganzes Makro anwenden.
Gruß, Daniel
Anzeige
AW: erstmal alle Selects rausschmeissen
01.11.2009 19:36:05
René
Hallo Daniel,
danke für Deine rasche Antwort. Werde das mal versuchen umzusetzen.
Freundliche Grüsse
René

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige