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

Makro tunen Hilfe!!
Burkhard
Hallo Leute,
habe vor kurzem hier einen Beitrag geschrieben, bezüglich meines etwas langsamen Makro.
franz hatte hier auch einen Vorschlag wie es etwas schneller gehen könnte, leider ist mein Beitrag geschlossen und ich kann nicht mehr Antworten, ich bin leider erst heute dazu gekommen hier zu lesen :-(
Vielleicht könnt ihr mich ja nochmal helfen und ich hoffe franz liest das auch nochmal.
Also hier nochmal das Makro um das es geht:
Sub AuswertungTage()
Dim strFormula As String, strFile As String, strPath As String, lngKW As Long
Dim vVorgabe, Zeile As Long, Spalte As Long, Tag As Long, Zeile1 As Long, Maschine
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
strPath = IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\")
With Sheets("TagesDaten")
'nächste leere Zeile in Liste in Spalte "KW"
Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
If Zeile = 2 Then ' noch keine Daten in Tabelle
lngKW = 1
Else
lngKW = .Cells(Zeile - 1, 2).Value + 1 'nächste KW
vVorgabe = Application.InputBox(Prompt:="Ab welcher KW sollen Daten eingelesen werden?" _
& vbLf & "Bei Eingabe 1 werden alle Daten neu eingelesen" _
& vbLf & "Letzte eingelesene KW: " & lngKW - 1, _
Title:="Tagesdaten der KW einlesen", Default:=lngKW, Type:=1)
If vVorgabe = False Then GoTo Beenden
If vVorgabe  "" Then
Zeile1 = Zeile
For Tag = 1 To 6
strFormula = "'" & strPath & "[" & strFile & "]" & cstrSheet & "'!"
Spalte = 8 + (Tag - 1) * 4 '1. Spalte des Tages (Anzahl Schichten)
'Formeln für Jahr-KW-Datum für alle Maschinen
.Range(.Cells(Zeile, 1), .Cells(Zeile + AnzMaschinen - 1, 1)).FormulaR1C1 = _
"=" & strFormula & "R1C1" 'Jahr aus Zelle A2 einlesen
.Range(.Cells(Zeile, 2), .Cells(Zeile + AnzMaschinen - 1, 2)).FormulaR1C1 = _
"=" & strFormula & "R1C2" 'KW aus Zelle C1 einlesen
.Range(.Cells(Zeile, 3), .Cells(Zeile + AnzMaschinen - 1, 3)).FormulaR1C1 = _
"=" & strFormula & "R5C" & Spalte 'Tages-Datum aus Zeile 5
'Formeln für Daten zu den einzelnen Maschinen eintragen
For Maschine = 1 To AnzMaschinen
strFormula = "'" & strPath & "[" & strFile & "]" & cstrSheet & "'!"
.Cells(Zeile, 4).Offset(Maschine - 1, 0).FormulaR1C1 = _
"=" & strFormula & "R" & Maschine + 6 & "C1" 'Maschinen-Nr.
.Cells(Zeile, 5).Offset(Maschine - 1, 0).FormulaR1C1 = _
"=" & strFormula & "R" & Maschine + 6 & "C2"  'Maschine-Produkt
.Cells(Zeile, 6).Offset(Maschine - 1, 0).FormulaR1C1 = _
"=" & strFormula & "R" & Maschine + 6 & "C" & Spalte ' Stück Frühschicht
.Cells(Zeile, 7).Offset(Maschine - 1, 0).FormulaR1C1 = _
"=" & strFormula & "R" & Maschine + 6 & "C" & Spalte + 1 'Stück Spätschicht
.Cells(Zeile, 8).Offset(Maschine - 1, 0).FormulaR1C1 = _
"=" & strFormula & "R" & Maschine + 6 & "C" & Spalte + 2 'Stück Nachtschicht
'.Cells(Zeile, 9).Offset(Maschine - 1, 0).FormulaR1C1 = _
"=" & strFormula & "R" & Maschine + 6 & "C" & Spalte + 3 'Stückzahl geamt
strFormula = "'" & strPath & "[" & strFile & "]" & cstrSheet2 & "'!"
.Cells(Zeile, 9).Offset(Maschine - 1, 0).FormulaR1C1 = _
"=" & strFormula & "R" & Maschine + 6 & "C" & Spalte + 3 'Ist Stückzahl
Next
'1. Zeile für nächsten Tag
Zeile = Zeile + AnzMaschinen
Next
'Formeln durch Werte ersetzen
With .Range(.Cells(Zeile1, 1), .Cells(Zeile - 1, 9))
.Calculate
.Value = .Value
End With
End If
Next
Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row 'letzte Zeile mit Daten
End With
'Formeln/Werte in Monatsauswertung aktualisieren
With Worksheets("Auswertung über Monate")
With .Range("E10:P30")
.FormulaR1C1 = _
"=SUMPRODUCT((RC1=Tagesdaten!R2C4:R" & Zeile & "C4)*(MONTH(R9C)=MONTH(Tagesdaten!R2C3:R" _
_
& Zeile & "C3))*Tagesdaten!R2C9:R" & Zeile & "C9)"
.Calculate
.Value = .Value 'Zeile aktivieren, wenn im Zellbereich keine Formeln stehen sollen
End With
'Erstellung Auswertung über Wochen
'Dim strFormula As String, strFile As String, strPath As String, lngKW As Long
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'strFormula = "'" & strPath & "[" & strFile & "]" & cstrSheet & "'!"
strPath = IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\")
With Sheets("Auswertung über Wochen 2011")
.Range("B10:BA31") = ""
For lngKW = 1 To 52
strFile = Dir(strPath & "*_KW" & CStr(lngKW) & ".xls*", vbNormal)
If strFile  "" Then
strFormula = "'" & strPath & "[" & strFile & "]" & cstrSheet2 & "'!"
.Range(.Cells(10, lngKW + 1), .Cells(31, lngKW + 1)).Formula = _
"=SUMPRODUCT((" & strFormula & "$A$7:$A$28=$A10)*(MOD(COLUMN($H:$AE)-7,4)=0)*" &  _
strFormula & "$H$7:$AE$28)"
End If
Next
.Calculate
.Range("B10:BA31") = .Range("B10:BA31").Value
End With
ErrExit:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End With
'ErrExit:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Beenden:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Franz sein Vorschlag war nun folgender:
Evtl. geht es aber auch schneller, wenn man die Arbeitsmappen mit den Daten der jeweiligen Kalenderwoche schreibgeschützt öffnet, die Werte direkt überträgt ohne den Umweg über die Formeln und die Mappe wieder schließt.
Dies würde ich jetzt gern nochmal Probieren, aber das übersteigt leider meine kenntnisse.
Ich würde mich über hilfe jderzeit freuen
Schöne Grüße
Burkhard

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro tunen Hilfe!!
22.07.2011 14:58:49
fcs
Hallo Burkhard,
ich hab jetzt mal versucht, die notwendigen Anpassungen im Blindflug zu machen.
Die Formeln für die Wochenzusammenfassung werden dabei in der gleichen Schleife bearbeitet wie die Tagesdaten, so dass die KW-Datei immer nur einmal geöffnet werden muss.
In der 1. Variante werden weiterhin Formeln eingefügt. Während des Einfügens der Formeln wird die Arbeitsmappe mit den zugehörigen Daten geöffnet.
https://www.herber.de/bbs/user/75817.txt
In der 2. Variante werden die Daten direkt aus den Tabellenblättern der KW-Datei in das Blatt "Tagesdaten" übertragen. Zusätzlich werden für die Wochen- und Monatszusammenfassungen die Formeln eingefügt und durch ihre Ergebnisse ersetzt.
https://www.herber.de/bbs/user/75818.txt
Gruß
Franz
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige