Hallo zusammen,
ich bin VBA Anfänger und benötige dringend Hilfe.... :-(
Ich lese eine CSV in Excel ein um die Daten dort zu verarbeiten, was auch prima funktioniert. Allerdings gibt mir Excel nur die erste Zeile der csv raus, ich benötige aber die zweite Zeile. Die csv besteht nur aus zwei zeilen, der Überschrift und der Datenzeile..ich bekomme nur die Überschrift....:-(
hier mal der Code:
Sub ReadfromCSVSimple(fname As Variant, Optional fs As String = ";")
Dim hfile As Integer ' Filehandle bzw. Dateinummer
Dim lAnzahl As Long ' Zähler über alle Zeilen
Dim OneLine As String ' eine Zeile als String
Dim myArr As Variant ' eine Zeile in Felder getrennt
Dim myArrRows As Variant ' Array zum Trennen des csv in mehrere Zeilen
Dim lnglast As Long
Dim zeichen As Variant
Dim iCnt As Integer 'Schleifenzaehler fuer Array. Bei vielen Daten Long nehmen
ThisWorkbook.Worksheets("Projektübersicht").Select
lnglast = Cells(Rows.Count, 1).End(xlUp).Row
If IsEmpty(Cells(lnglast, 1)) Then lnglast = Cells(lnglast, 1).End(xlUp).Row
lnglast = lnglast + 1 ' ermittelt die erste freie Zeile
hfile = FreeFile
Open fname For Input As #hfile
Line Input #hfile, OneLine
If OneLine <> "" Then ' ist die Zeile NICHT leer?
myArrRows = Split(OneLine, Chr(10)) 'erst mal in "Zeilen" trennen, Zeichen 0A
myArr = Split(OneLine, fs) ' dann am Trennzeichen separieren
myArr = Split(myArrRows(iCnt), fs) ' dann am Trennzeichen separieren
If UBound(myArr) > 1 Then
With Worksheets("Projektübersicht")
.Cells(lnglast, 33) = Replace(myArr(15), Chr$(34), vbNullString) 'Firma/ Name
.Cells(lnglast, 37) = Replace(myArr(17), Chr$(34), vbNullString) ' Straße
.Cells(lnglast, 35) = Replace(myArr(18), Chr$(34), vbNullString) ' PLZ
.Cells(lnglast, 36) = Replace(myArr(19), Chr$(34), vbNullString) 'Ort
.Cells(lnglast, 38) = Replace(myArr(16), Chr$(34), vbNullString) ' Ansprechpartner
.Cells(lnglast, 39) = Replace(myArr(20), Chr$(34), vbNullString) ' Telefon
.Cells(lnglast, 40) = Replace(myArr(22), Chr$(34), vbNullString) ' Mail
'.Cells(lnglast, 9) = Replace(myArr(64 - 54), Chr$(34), vbNullString) ' Abwicklung über: Firma/ Name
'.Cells(lnglast, 13) = Replace(myArr(74 - 54), Chr$(34), vbNullString) ' Straße
'.Cells(lnglast, 11) = Replace(myArr(2), Chr$(34), vbNullString) ' PLZ:
'.Cells(lnglast, 12) = Replace(myArr(76 - 54), Chr$(34), vbNullString) ' Ort
'.Cells(lnglast, 8) = Replace(myArr(77 - 54), Chr$(34), vbNullString) ' Ansprechpartner
'.Cells(lnglast, 14) = Replace(myArr(78 - 54), Chr$(34), vbNullString) ' Telefon:
'.Cells(lnglast, 15) = Replace(myArr(79 - 54), Chr$(34), vbNullString) ' Mail
.Cells(lnglast, 3) = Replace(myArr(23), Chr$(34), vbNullString) ' BV
.Cells(lnglast, 7) = Replace(myArr(27), Chr$(34), vbNullString) ' Straße
.Cells(lnglast, 5) = Replace(myArr(28), Chr$(34), vbNullString) ' PLZ
.Cells(lnglast, 6) = Replace(myArr(29), Chr$(34), vbNullString) 'Ort
.Cells(lnglast, 16) = Replace(myArr(30), Chr$(34), vbNullString) 'Ansprechpartner
.Cells(lnglast, 22) = Replace(myArr(31), Chr$(34), vbNullString) 'Telefon
.Cells(lnglast, 23) = Replace(myArr(33), Chr$(34), vbNullString) 'Mail
'.Cells(lnglast, 42) = Replace(myArr(67 - 54), Chr$(34), vbNullString) 'Wunschtermin
'.Cells(lnglast, 43) = Replace(myArr(95 - 54), Chr$(34), vbNullString) 'Freitext
.Cells(lnglast, 31) = "Objekt:" & " " & Replace(myArr(34), Chr$(34), vbNullString) _
& vbCrLf & "Objekthersteller:" & " " & Replace(myArr(35), Chr$(34), vbNullString) _
& vbCrLf & "Objektalter:" & " " & Replace(myArr(36), Chr$(34), vbNullString) _
& vbCrLf & "Trägermaterial:" & " " & Replace(myArr(37), Chr$(34), vbNullString) _
& vbCrLf & "Oberfläche:" & " " & Replace(myArr(38), Chr$(34), vbNullString) _
& vbCrLf & "Farbsystem-Nr.:" & " " & Replace(myArr(39), Chr$(34), vbNullString) _
& vbCrLf & "Glanzgrad:" & " " & Replace(myArr(40), Chr$(34), vbNullString) _
& vbCrLf & "Schadensumfang:" & " " & Replace(myArr(40), Chr$(34), vbNullString) _
& vbCrLf & "Schadensort:" & " " & Replace(myArr(41), Chr$(34), vbNullString) _
& vbCrLf & "Schadensursache:" & " " & Replace(myArr(42), Chr$(34), vbNullString) & vbCrLf & "Schadensbeschreibung:" & " " & Replace(myArr(43), Chr$(34), vbNullString)
End With
lnglast = lnglast + 1
End If
End If
Close #hfile
Kill fname
End Sub
Private Sub CommandButton1_Click()
Dim Dateiname As Variant
Dateiname = Application.GetOpenFilename(filefilter:="Textdateien (*.csv), *.csv")
If Dateiname <> "Falsch" Or Dateiname <> False Then
Else
Exit Sub
End If
Call ReadfromCSVSimple(Dateiname, ";")
Unload UserForm3
End Sub
Private Sub CommandButton2_Click()
Unload Me
UserForm4.Show
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Kann mir hier bitte jemand helfen, kann doch eigentlich nicht so schlimm sein, oder???
vielen lieben Dank im Vorraus,
der Soeren
|