Hallo zusammen,
mal wieder hoffe ich auf eure Unterstützung :-).
Ich habe folgendes Problem. Wie schon in den Threads zuvor beschrieben möchte ich mittles VBA eine Prozedur nacheinander für 65 Excel Files durchlaufen lassen.
Dabei wird das erste zu bearbeitende Excel Sheet geöffnet, die Prozedur wird abgearbeitet und das File schließt sich wieder und ein neues wird wieder geöffnet.
Das öffnen und schließen klappt einwandfrei.
Nun möchte ich dass in den Variablen Sheets folgende Prozedur abgerabeitet werden soll.
Ein neues Sheet soll angelegt werden (Ist dann Sheet(3)) und in diesem soll in Zelle "A2" folgende Formel eingetragen werden:
=('2011-05-05_Orders.xlsx'!C2-'2011-05-05_Orders.xlsx'!B2)/AVERAGE('2011-05-05_Orders.xlsx'!B2:C2). Sheet2 ist die Datenquelle.
Es soll (C2 - B2) / Durschnitt (B2:C2) berechnet werden.
Wobei abhängig von der geöffneten Datei, der Worksheet Name unterschiedlich ist. Das zu referenzierende Tabellenblatt (YYYY-MM-DD_Orders) steht immer an der zweiten Stelle (Worksheet(2)).
Diese Formel soll dann bis Zeile 6601 eingetragen werden. Mein Problem liegt derzeit darin das richtige Tabellenblatt anzusprechen, damit es für alle 65 Excel Dateien klappt.
Nachdem die Formel eingetragen wurde soll der ganze Bereich in ein festes Workbook in Worksheet(1) kopiert werden (von dort aus wird der VBA Code abgespielt). Hier wäre es wichtig, dass für jede neu geöffnete Datei der eingefügte Bereich in die nächsten leere Spalte im festen Workbook kopiert wird. Sodass ich am Ende im festen Workbook 65 +1 Spalten eingefügt habe (+1 da in Spalte A der Festen Datei Uhrzeiten im Bereich A1:A6601 stehen)
Auch hat das schließen der variablen Datei mit Workbooks(StrFile).Close nicht richtig geklappt. Es erscheint der Error - "Subscript out of Range"
Mein Code sieht derzeit so aus:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | Sub Spread_CalcExp()
Dim Source As String
Dim StrFile As String
Const csPath As String = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\Aggr_Orders_Match\"
Dim i As Integer
Dim j As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Source = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\"
StrFile = Dir(Source)
Do While Len(StrFile) > 0
Workbooks.Open Filename:=Source & StrFile
StrFile = Dir()
Sheets.Add After:=ActiveSheet
Range( "A2" ).FormulaR1C1 = _
"=(Worksheets(2).Name & '!RC[2] - Worksheets(2).Name & '!RC[1])/AVERAGE(Worksheets(2).Name & '!RC[1]:RC[2])"
Range( "A2" ).AutoFill Destination:=Range( "A2:A6601" ), Type:=xlFillDefault
Range( "A1" ).FormulaR1C1 = "Relative Spread"
Range( "A:A" ).Style = "Percent"
Range( "A:A" ).NumberFormat = "0.0000%"
Workbooks(StrFile).Close savechanges:= False
Loop
Application.ScreenUpdating = True
End Sub
|
Vielen Dank für eure Hilfe & ein schönes Wochendende
Maximilian
|