Grüezi
Steve schrieb am 14.07.2006
I need to import a csv file that has more than 65536 rows of data and 20
columns, is there a way of setting up a vba macro so that once the 65536 has
been reached, the continuation moves onto the next sheet?
I once worte the following Code for this issue - it even splits the datas
to columns when you define the separator in the second part of the code.
The comments are in German, bout it should easy to change them:
Option Explicit
Option Base 1
Sub LargeFileImport()
Dim Filename As String
Dim FileNum As Integer
Dim ResultStr As String
Dim wsSheet As Worksheet
Dim strValues() As String
Dim lngRows As Long
Dim lngRow As Long
Dim intSheet As Integer
Filename = Application.GetOpenFilename("Textdateien " & _
"(*.txt; *.csv;*.asc),*.txt; *.csv; *.asc")
If Filename = "" Or Filename = "Falsch" Then Exit Sub
FileNum = FreeFile()
On Error GoTo ErrorHandler
Open Filename For Input As #FileNum
Application.ScreenUpdating = False
Workbooks.Add template:=xlWorksheet
lngRows = ActiveSheet.Rows.Count
lngRow = 1
intSheet = 1
ReDim strValues(lngRows, 1)
Application.StatusBar = " Einlesen Blatt " & intSheet & " / 0 %"
Do While Seek(FileNum) <= LOF(FileNum)
Line Input #FileNum, ResultStr
If Left(ResultStr, 1) = "=" Then
strValues(lngRow, 1) = "'" & ResultStr
Else
strValues(lngRow, 1) = ResultStr
End If
If lngRow < lngRows Then
lngRow = lngRow + 1
If (lngRow * 100 / lngRows) Mod 10 = 0 Then
Application.StatusBar = " Einlesen Blatt " & intSheet & _
" / " & Int(lngRow * 100 / lngRows) & " %"
End If
Else
Application.StatusBar = " Schreibe Daten in Blatt " & intSheet
ActiveSheet.Range("A1:A" & lngRows) = strValues
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
ReDim strValues(lngRows, 1)
lngRow = 1
intSheet = intSheet + 1
Application.StatusBar = "Einlesen Blatt " & intSheet
End If
Loop
Close
ActiveSheet.Range("A1:A" & lngRows) = strValues
' Beginn der Aufteilung in Spalten
Dim strDelimiter As String
Do
strDelimiter = Application.InputBox("1 ==> Tabulator " & Chr(13) & _
"2 ==> Semikolon" & Chr(13) & _
"3 ==> Komma" & Chr(13) & _
"4 ==> Leerzeichen" & Chr(13) & _
"5 ==> Andere" & Chr(13) & _
"Trennzeichen wählen", "1", Type:=1)
Loop Until CInt(strDelimiter) >= 0 And CInt(strDelimiter) <= 5
If strDelimiter = 5 Then
Dim strDelimOther As String
strDelimOther = Application.InputBox("Bitte das verwendete" _
& "Trennzeichen eingeben" & Chr(13) & _
"00 ==> Abbruch ", _
"Trennzeichen wählen", Type:=2)
If strDelimOther = "00" Then GoTo ErrorHandler
End If
intSheet = 0
For Each wsSheet In ActiveWorkbook.Worksheets
intSheet = intSheet + 1
Application.StatusBar = "Bearbeiten von Blatt " & intSheet
With wsSheet
.Range("A:A").TextToColumns Destination:=.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=IIf(strDelimiter = "1", True, False), _
Semicolon:=IIf(strDelimiter = "2", True, False), _
Comma:=IIf(strDelimiter = "3", True, False), _
Space:=IIf(strDelimiter = "4", True, False), _
Other:=IIf(strDelimiter = "5", True, False), _
OtherChar:=IIf(strDelimiter = "5", strDelimOther, "")
End With
Next wsSheet
ErrorHandler:
Application.ScreenUpdating = True
Application.StatusBar = "Fertig"
End Sub
Mit freundlichen Grüssen
Thomas Ramel
--
- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2000 SP-3]
Microsoft Excel - Die ExpertenTipps:
(
http://tinyurl.com/9ov3l und
http://tinyurl.com/cmned)