Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1088to1092
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

Macro kürzen!?

Macro kürzen!?
lisa
Hallo zusammen
Ich bräuchte mal eine Hilfestellung zu meinem Makro.
Kann man dieses Makro evtl. kürzen und beschleunigen?
Danke im Voraus!
Sub Makro9()
Range("BW6").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R13C8"
Range("BW7").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R14C8"
Range("BW8").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R15C8"
Range("BW9").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R16C8"
Range("BW10").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R17C8"
Range("BW11").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R18C8"
Range("BW12").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R19C8"
Range("BW13").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R20C8"
Range("BW14").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R21C8"
Range("BW15").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R22C8"
Range("BW16").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R23C8"
Range("BW17").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R24C8"
Range("BW18").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R25C8"
Range("BW19").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R26C8"
Range("BW20").FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & Range("bw2").Text & "'! _
R27C8"
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Macro kürzen!?
22.07.2009 14:57:32
Luschi
Hallo Lisa,
versuch es mal so.

Dim i As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
For i = 6 To 20
Range("BW" & i).FormulaR1C1 = _
"='[KW " & Range("bw3") & " _  tgl Linienkennzahlen.xls]" & _
Range("bw2").Text & "'!R" & (i + 7) & "C8"
Next i
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
Gruß von Luschi
aus klein-Paris
AW: Macro kürzen!?
22.07.2009 15:28:51
lisa
Hallo
Herzlichen Dank für die schnelle Antwort!
Ja, das Macro sieht ja schon sehr schlank aus!
Es funktioniert auch, nur leider nicht schneller!
Kann es daran liegen, dass es eine Verlinkung ist?
Gruß Lisa
Anzeige
AW: Macro kürzen!?
22.07.2009 15:36:32
Luschi
Hallo Lisa,
an der Langsamkeit erkennt man, daß auch M$ nicht Daten aus geschlossenen Dateien lesen kann.
Es wird jede in Formeln angesprochene Datei im Hintergrund geöffnet, um die Werte auszulesen. Sind das dann noch große Dateien, die auch noch viele ActiveX-Steuerelemente in den Tabellenblättern haben, dann muß für jedes dieser Elemente noch eine temporäre Datei zusätzlich erstellt und geöffnet werden.
Das kostet dann eben diese Zeit.
Gruß von Luschi
aus klein-Paris
AW: Macro kürzen!?
22.07.2009 16:36:06
lisa
Hallo
Ok, das erscheint selbst mir logisch!
Würde also heißen um es schneller hinzubekommen Datei öffnen alle mit einmal kopieren und wieder schliessen!
Nun muss ich aber wie du wahrscheinlich schon am Macro sehen kontest mehrer Mappen, die alle in einem Ordner liegen öffnen die richtige Tabelle finden!
Hierzu bräuchte ich dann aber einen Check der guckt ob 1. Die Datei vorliegt und 2. guckt welche Zelle schon beschrieben ist und welche nicht. ohhhhhhhh wie soll ich das denn machen?
Vieleicht in kleinen Schritten!
Hier mal mein Macro zum öffnen und kopieren.
Dim sName As String
sName = Range("a2").Text
Workbooks.Open Filename:= _
"W:\Tagesberichte\2009\KW " & Range("A1") & " _ tgl Linienkennzahlen.xls"
Sheets(sName).Select' bis hier öffne und selctiere meine Tabelle!
Range("H13").Copy' ab hier kopiere ich und füge in meine Zieldatei wieder ein
Windows("Mappe2").Activate
Range("BW6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("KW 29 _ tgl Linienkennzahlen.xls").Activate
Range("M13").Copy
Windows("Mappe2").Activate
Range("BW7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("KW 29 _ tgl Linienkennzahlen.xls").Activate
Range("H14").Copy
Windows("Mappe2").Activate
Range("BW8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("KW 29 _ tgl Linienkennzahlen.xls").Activate
Range("M14").Copy
Windows("Mappe2").Activate
Range("BW9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
jetzt müsste aber erst geprüft werden, ob die Zellen bw 6- 9 schon beschrieben sind wenn ja brauch auch ichts mehr geöffnet oder kopiert werden und ob die Datei vorhanden ist!
? kannst du mir dabei helfen?
Gruß Lisa
Anzeige
AW: Macro kürzen!?
27.07.2009 08:24:01
fcs
Hallo Lisa,
Hier mal ein ungetesteter Ansatz für eine Datei. Wenn du mehrere Dateien abarbeiten willst, dann muss hierfür ggf. noch eine äußere For-Next-Schleife angelegt werden.
Wichtig ist, dass hier mit entsprechenden Objektvariablen gearbeitet wird. Dadurch entfallen die bremsenden Select und Activate-Anweisungen und der Code wird etwas übersichtlicher.
Gruß
Franz
Sub Daten_Laden()
Dim sName As String, sDateiName As String
Dim wbKW As Workbook, wbZiel As Workbook
Dim wksKW As Worksheet, wksZiel As Worksheet
Dim i As Integer, ZeileZiel As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
Set wbZiel = ActiveWorkbook
Set wksZiel = ActiveSheet
ZeileZiel = 6 '1. Zeile im Zielblatt in die kopiert werden soll
'Hier ggf. For-Schleife für mehrere KW-Dateien beginnen
sDateiName = "W:\Tagesberichte\2009\KW " & Range("A1") & " _ tgl Linienkennzahlen.xls"
sName = wksZiel.Range("a2").Text
'Prüfen ob KW-Datei vorhanden
If Dir(Pathname:=sDateiName, Attributes:=vbNormal)  "" Then
Set wbKW = Workbooks.Open(Filename:=sDateiName, ReadOnly:=True)
Set wksKW = wbKW.Worksheets(sName) ' bis hier öffne und selctiere meine Tabelle!
' ab hier kopiere ich und füge in meine Zieldatei wieder ein
For i = 1 To 4 'Anzahl zu kopierender Werte
If IsEmpty(wksZiel.Range("BW" & ZeileZiel)) Then
Select Case i
Case 1: wksKW.Range("H13").Copy
Case 2: wksKW.Range("M13").Copy
Case 3: wksKW.Range("H14").Copy
Case 4: wksKW.Range("M14").Copy
End Select
wksZiel.Range("BW" & ZeileZiel).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,  _
_
SkipBlanks:=False, Transpose:=False
ZeileZiel = ZeileZiel + 1
Else
ZeileZiel = ZeileZiel + 1
End If
Next i
Application.CutCopyMode = False
'KW-Datei wieder schliessen
wbKW.Close savechanges:=False
Else
MsgBox "Datei """ & sDateiName & """ nicht vorhanden!"
End If
'Hier ggf. Schleife für mehrer Dateien beenden
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige