Guten Abend!
Habe nochmal geschaut. War ein wenig mehr zum Ändern (war mit vorher gar nicht aufgefallen). Der "Type Mismatch" kommt daher, dass Tab2 und Formel nicht als String deklariert sind aber einen String bekommen. Habe ich geändert. Außerdem gibt es jetzt noch die Variable Tabe. Diese nimmt den Namen des eingefügten Blattes auf (ist ja nicht immer Worksheet3). Sonst klappt der Zugrif nicht.
Bei der Formel müsstest du MITTELWERT in deutsch lassen. Da die Formel als FormulaLocal eingefügt wird, gitl die Heimatsprache im System (ich gehe von deutsch aus). Sollte es auf einem englischen System laufen, geht auch Average. Dann müsste aber die FOrmel angepasst werden, da in der engl. Version die Interpunktion in der Formel eine andere wäre. Dann mal Bescheid geben.
Und ein letzter Punkt bzgl. der Laufzeit. Du hast beim Schließen der Dateien savechanges: true gesetzt. Das heißt, dass immer das neu eingefügte Blatt (deshalb habe ich Tabe eingeführt) und die 6600 Formel gespeichert werden müssen. Das insgesamt 65 Mal. Das hat auf meiner alten Mühle hier ziemlich gedauert. Wenn es nicht notwendig ist, das einfach auf false setzen. DAnn wird es schneller und die Daten sind ja in deine Datei übernommen.
HIer jetzt also der Code der funktionieren sollte. (Pfade und Dateinnamen sollte passen - hoffentlich :-))
Sub Spread_CalcExp()
'Open Files
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
Dim objRange As Range
Dim Spalte As Integer
Dim Ausgang As String
Dim Tab2 As String
Dim Formel As String
Dim Tabe As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'do not forget last backslash in source directory.
Source = "C:\Users\Maximilian\Documents\Studium\Bachelor Arbeit\Data\"
StrFile = Dir(Source)
'die Datei aus der das Makro startet und die Werte eingetragen werden
Ausgang = "Order_Spread_Export.xlsm"
Do While Len(StrFile) > 0
'sucht die aktuelle Spalte in der Ausgangsdatei
Spalte = Workbooks(Ausgang).Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
'öfnet die erste Datei
Workbooks.Open Filename:=Source & StrFile
' Prozedur Spread Start
Sheets.Add After:=ActiveSheet
'Name der eingefügten Tabelle
Tabe = Workbooks(StrFile).ActiveSheet.Name
'einfügen der Formel, ggf. könnte man das auch mit for und einem Code durch alle 6601 durchlaufen, könnte aber länge dauern
Tab2 = Workbooks(StrFile).Worksheets(2).Name
Formel = "=(" & Tab2 & "!B2-" & Tab2 & "!C2)/MITTELWERT(" & Tab2 & "!B2;" & Tab2 & "!C2)"
'Range für A2 bs A6601 festlegen
Set objRange = Workbooks(StrFile).Worksheets(Tabe).Range("A2:A6601") 'Cells(11, 6).Resize(zeilen - 11, 1) 'Bereichlänge anpassen....
'Formel einfügen
objRange.FormulaLocal = Formel
Set objRange = Nothing
Workbooks(StrFile).Worksheets(Tabe).Range("A1").Value = "Relative Spread" 'Einfügen einer Überschrift
' die Formatierungen
Workbooks(StrFile).Worksheets(Tabe).Range("A:A").Style = "Percent"
Workbooks(StrFile).Worksheets(Tabe).Range("A:A").NumberFormat = "0.0000%"
' Prozedur Spread Ende
'Ab hier soll die Range("A:A") in das Workbook("Order_Spread_Export") in Sheet1 in die nächste leere Spalte kopiert werden.
' Danach soll sich dass Variable Sheet schließen und ein neues Sheet bearbeitet werden
Workbooks(StrFile).Worksheets(Tabe).Range("A:A").Copy
'Odner Order_Spread_Export.xls aktivieren und dann die Werte einfügen
Workbooks(Ausgang).Activate
'jetzt einfügen, letzter Wert war in Spalte deshalb Spalte +1
Workbooks(Ausgang).Worksheets(1).Columns(Spalte + 1).PasteSpecial (xlPasteValuesAndNumberFormats)
Workbooks(StrFile).Close savechanges:=True
' nächste Datei holen
StrFile = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Schönen Abend noch!
Gruß Matthias
|