Hallo Ich habe einen Macro der bei kleinen Dateien (36kb, 178 Zeilen) gut läuft, jetzt habe ich es mal mit grosser Datei (694 kb, 3570 Zeilen) versucht und bekomme den Fehler 7, run out of memory.
Weiss zufällig einer wie man das Problem lösen könnte? So sieht der code aus bis zu dem Punkt wo es abstürzt
Sub Auto_Open()
UserForm1.Show
Application.ScreenUpdating = False
Dim xPathAndFile As Variant
Dim xfn&
Dim xTxt$
Dim xA As Variant
Dim xB As Variant
Dim xi&
Dim xC As Variant
Dim xD As Variant
Dim wks As Worksheet
Dim xLastRow As Long
Dim rngX As Excel.Range
Dim wksE As Excel.Worksheet
'oder:
'xPathAndFile = ThisWorkbook.Path & "\" & "excel.ashx"
xPathAndFile = Application.GetOpenFilename("Files (*.ashx), *.ashx", Title:="File gesucht")
If xPathAndFile = False Then
MsgBox "Nichts ausgewählt!"
Exit Sub
End If
xfn = FreeFile
Open xPathAndFile For Binary As xfn
xTxt = Space(LOF(xfn))
Get xfn, 1, xTxt
Close xfn
'Zeilenunbrüche zur unterscheidung von Spaltenumbrüchen umbenennen
xTxt = Replace(xTxt, vbCrLf, Chr(0), 1, -1, 0)
'Umbrüche in den Zellen entfernen
xTxt = Replace(xTxt, vbCr, " ", 1, -1, 0)
'alle &lttd&gt durch Tab ersetzen
xTxt = Replace(xTxt, "&lttd&gt", vbTab, 1, -1, 1)
'Alle Html Tags entfernen
xTxt = Replace(xTxt, "&lttable&gt", "", 1, -1, 1)
xTxt = Replace(xTxt, "&lt/table&gt", "", 1, -1, 1)
xTxt = Replace(xTxt, "&lt/td&gt", "", 1, -1, 1)
xTxt = Replace(xTxt, "&lttr&gt", "", 1, -1, 1)
xTxt = Replace(xTxt, "&lt/tr&gt", "", 1, -1, 1)
xTxt = Replace(xTxt, "&ltb&gt", "", 1, -1, 1)
xTxt = Replace(xTxt, "&lt/b&gt", "", 1, -1, 1)
xTxt = Replace(xTxt, "&ltbr/&gt", "", 1, -1, 1)
Do While InStr(1, xTxt, "&lt", 1)
xTxt = Left(xTxt, InStr(1, xTxt, "&lt", 1) - 1) & Mid(xTxt, InStr(1, xTxt, "&gt", 1) + 1)
Loop
bei der Do While schleife, vorletzte Zeile stürzt es ab