Hallo Liebe Community,
ich habe ein Problem, ich muss eine große Datei bearbeiten, aber wenn ich den Code ausführe wächst der Speicher bis 1,66 gig an und bricht danach ab.
Mit kleineren Dateien funktioniert es problemlos!
Sub split()
Application.ScreenUpdating = False
Dim wkbSource As Excel.Workbook
Dim wkbImport As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim rngResult As Excel.Range
Dim strFirstAddr As String
Dim strPath As String
Dim strFilename As String
Dim lngRowId As Long
Dim r As Range
Dim limit As Long
Dim loops As Integer
strPath = "K:\ALC\User\msu\RBPL_TimeSeries\"
For i = 5 To 8
Set wkbSource = Workbooks.Open(strPath & i & ".xlsx")
With wkbSource.Sheets(1)
Set r = .[A1]
limit = .Cells(.Rows.Count, r.Column).End(xlUp).Row
loops = (limit \ 30000) + 1
End With
For j = 1 To loops
With wkbSource.Sheets(1)
Set r = .Range(.Cells((j - 1) * 30000 + 1, 1), .Cells((j * 30000), 1))
r.TextToColumns Destination:=r, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(39, 3), Array(40, 2), Array(38, 2)), TrailingMinusNumbers:=True
End With
Next j
'spalten löschen
'datei speichern
Range(Columns(1), Columns(19)).Delete 'asset liab
Range(Columns(2), Columns(11)).Delete 'countparty
Range(Columns(3), Columns(9)).Delete 'cur_bk_bal
Range(Columns(4), Columns(11)).Delete 'currency
Range(Columns(5), Columns(189)).Delete 'data_source, book_code, contract_type
Range(Columns(8), Columns(117)).Delete 'attribte_5
Range(Columns(9), Columns(11)).Delete 'attribte_9
Range(Columns(10), Columns(45)).Delete 'as_of_date
Range(Columns(11), Columns(11)).Delete
wkbSource.Close (True)
Next i
End Sub
Vielen Dank im Voraus
|