Sub CSVOeffnen()
Dim DateiName As Variant
DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If DateiName <> False Then _
Workbooks.OpenText DateiName, Comma:=True
End Sub
Gruß Jürgen
Danke Jürgen,
ich hab meinen PC grad ausgemacht und wollt mich auf die Couch schmeißen. Ich werds morgen spätestens übermorgen ausprobieren und mich dann melden.
Trotzdem danke im voraus!
Leider der gleiche Fehler
Jordan
Hallo Jürgen,
habs gerade versucht! Hier passiert mir der gleiche Fehler, den ich schon hatte. Die Auswahl steht zwar auf csv, jedoch wird die Datei nicht aufbereitet und es sind nur die ersten zwei Spalten mit allen Daten gefüllt!
Hast du noch eine Idee?
Welches Trennzeichen ...
Backowe
Hi Jordan,
... wird denn verwendet?
Gruß Jürgen
AW: Welches Trennzeichen ...
Jordan
Hi Jürgen,
das Semikolon. Hab ich aber schon umgestellt. Sprich ....Semicolon:=True.
Bringt aber das gleiche Ergebnis
vielleicht gehts hiermit...
Tino
Hallo,
habe hier auch mal was zusammengebaut.
Es wird nach der Datei, nach den Trennzeichen und ab welcher Zelle der Import beginnen soll.
kommt als Code in Modul1
Option Explicit
Function TxT_ReadAll(ByVal sFilename As String) As String
Dim F As Integer
Dim sInhalt As String
If Dir$(sFilename, vbNormal) <> "" Then
F = FreeFile
Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
TxT_ReadAll = sInhalt
End Function
Sub ImportCSV()
Dim strDel As String, strInhalt As String, strDatei As String
Dim rngErste As Range
Dim myAr, myArZeile, myArNum
Dim A As Long, B As Long
Dim iCalc As Integer
'Abfrage Datei
strDatei = Application.GetOpenFilename("CSV Files (*.csv), *.csv, Text File(*.txt),*.txt")
If strDatei = CStr(False) Then GoTo Benutzerabbruch:
'Abfrage für Trennzeichen
AbfrageDelimiter:
strDel = InputBox("Geben Sie das verwendete Trennzeichen der CSV Datei ein", "CSV- Delimeter?")
If StrPtr(strDel) = 0 Then GoTo Benutzerabbruch:
If strDel = "" Then
If MsgBox("Sie haben kein Delimiter eingegeben!" & vbCr & _
"Wollen Sie den Vorgang wiederholen drücken Sie auf 'Wiederhohlen'" & vbCr & _
"Wollen Sie den Vorgang abbrechen drücken auf 'Abbrechen'", vbRetryCancel, "Keine Trennzeichen") = vbRetry Then
GoTo AbfrageDelimiter:
Else
Exit Sub
End If
End If
'Abfrage erste Zelle
On Error Resume Next
Set rngErste = Application.InputBox("In welcher Zelle soll der Import beginnen?", "Zelle auswählen", Selection(1).Address, , , , , 8)
Err.Clear
If rngErste Is Nothing Then GoTo Benutzerabbruch:
'Datei lesen
strInhalt = TxT_ReadAll(strDatei)
If strInhalt = "" Then 'Datei leer?
MsgBox "Die Datei ist leer! Der Import wird abgebrochen!", vbInformation
Exit Sub
End If
myAr = Split(strInhalt, vbCr)
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
On Error GoTo ErrorHandler:
For A = Lbound(myAr) To Ubound(myAr)
myAr(A) = Application.WorksheetFunction.Clean(myAr(A))
myArZeile = Split(myAr(A), strDel)
If Ubound(myArZeile) > -1 Then
'Textzahlen in Zahl umwandeln
myArNum = rngErste.Resize(, Ubound(myArZeile) + 1)
For B = 1 To Ubound(myArNum, 2)
If IsNumeric(myArZeile(B - 1)) And myArZeile(B - 1) <> "" Then
myArNum(1, B) = myArZeile(B - 1) * 1
Else
myArNum(1, B) = myArZeile(B - 1)
End If
Next B
rngErste.Resize(, Ubound(myArZeile) + 1) = myArNum
Set rngErste = rngErste.Offset(1, 0)
End If
Next A
ActiveSheet.UsedRange.EntireColumn.AutoFit
ErrorEnd:
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic ' iCalc
End With
Exit Sub
Benutzerabbruch:
MsgBox "Der Import wurde vom Benutzer abgebrochen!", vbInformation
Exit Sub
ErrorHandler:
MsgBox "Es sind Fehler bei der Verarbeitung aufgetreten!" & vbCr & vbCr & Err.Number & vbCr & vbCr & Err.Description, vbCritical, "Error"
GoTo ErrorEnd:
End Sub
Gruß Tino
Lade doch mal ein Beispiel hoch, ....
Backowe
Hi Jordan,
... ansonsten verantstalten wir nur ein heiteres Rätselraten!
Gruß Jürgen
Hast recht, mach ich morgen.....
Jordan
Danke trotzdem für Eure Ideen
Beispiele anbei...
Jordan
Hallo Zusammen,
hier nun mal zwei Beispiele. Leider geht der Upload einer *.csv Datei nicht. Drum hab ich die hier im Textformat hochgeladen.
Also: Hier nun meine Muster CSV Datei:
https://www.herber.de/bbs/user/62925.txt
Und wenn ich die mit dem Code von Jürgen öffne
Sub CSVOeffnen()
Dim DateiName As Variant
DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If DateiName False Then _
Workbooks.OpenText DateiName, Semicolon:=True
End Sub
, dann kommt das ganze so raus
https://www.herber.de/bbs/user/62926.xls
Die Lösung von Tino hab ich noch nicht versucht!
Viele Grüße
Jordan
Hi Jordan,
öffne sie einfach so:
VBA-Code: | Sub CSVOeffnen()
Dim i&, n&
Dim Zeile As String
Dim Ergebnis As Variant
Dim DateiName As Variant
DateiName = Application.GetOpenFilename("CSV Dateien (*.csv), *.csv")
If DateiName <> False Then
i = 1
Open DateiName For Input As #1
Do While Not EOF(1)
Line Input #1, Zeile
Ergebnis = Split(Zeile, ";")
For n = 0 To UBound(Ergebnis)
Cells(i, n + 1) = Ergebnis(n)
Next
i = i + 1
Loop
Close #1
End If
End Sub
Gruß Jürgen
Danke Jürgen,
ich steig zwar nicht so ganz dahinter, was da in dem Makro abläuft! Aber es geht.
Danke!
|
|