Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1904to1908
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Array

Array
23.10.2022 13:17:03
Herbert_Grom
Hallo,
wie sagte schon der große Philosoph Gerhard Polt: "Wenn einer sich förmlich in einen Gedanken hinein verrennt, dann ist er ja wie vernagelt!". Und so geht es mir gerade.
Ich habe einen Code, der mir eine mehrspaltige CSV ausliest und in ein Sheet rein schreibt. So weit so gut. Dauert 25 Sekunden. Nun möchte ich das aber gerne mit einem Array lösen und stehe irgendwie auf dem Schlauch. Habt ihr mir da bitte einen Vorschlag?
Hier ist mein Code:

Sub CSV_importieren()
Dim QuellDatei$, Inhalt$, Daten() As String, Zeile%, Spalte%, letztezeile%, i%, K%
Zeile = 1
Spalte = 1
QuellDatei = "x:\x\x.csv"
Open QuellDatei For Input As #1
'Daten in das Tabellenblatt eintragen
Do While Not EOF(1)
Line Input #1, Inhalt 'Inhalt der QuellDatei zeilenweise einlesen
Daten = Split(Inhalt, ";")
For i = 0 To UBound(Daten)
For K = 0 To UBound(Daten)
Sheets("Import").Cells(Zeile, Spalte) = Daten(i)
Spalte = Spalte + 1
i = i + 1
Next K
Zeile = Zeile + 1
Spalte = 1
Next i
Loop
Close #1
End Sub
Servus

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Array
23.10.2022 13:52:30
Nepumuk
Hallo Herbert,
so?

Option Explicit
Public Sub CSV_importieren()
Const FOR_READING As Long = 1
Const TRISTATE_USEDEFAULT As Long = -2
Dim objFileSystemObject As Object, objFile As Object, objTextStream As Object
Dim astrRows() As String, astrColumns() As String, strText As String
Dim lngRow As Long, ialngIndex As Long
Set objFileSystemObject = CreateObject(Class:="Scripting.FileSystemObject")
Set objFile = objFileSystemObject.GetFile("H:\Mappe1.csv") '                  Pfad anpassen !!!
Set objTextStream = objFile.OpenAsTextStream(FOR_READING, TRISTATE_USEDEFAULT)
strText = objTextStream.ReadAll
Set objTextStream = Nothing
Set objFile = Nothing
Set objFileSystemObject = Nothing
astrRows = Split(strText, vbCrLf)
lngRow = 1
For ialngIndex = LBound(astrRows) To UBound(astrRows)
If Len(Trim$(astrRows(ialngIndex))) > 0 Then
astrColumns = Split(Convert(astrRows(ialngIndex)), ";")
Cells(lngRow, 1).Resize(1, UBound(astrColumns) + 1).Value = astrColumns
lngRow = lngRow + 1
End If
Next
End Sub
Private Function Convert(ByVal pvstrText As String) As String
pvstrText = Replace$(pvstrText, "", vbNullString)
pvstrText = Replace$(pvstrText, "Ä", "Ä")
pvstrText = Replace$(pvstrText, "Ö", "Ö")
pvstrText = Replace$(pvstrText, "Ü", "Ü")
pvstrText = Replace$(pvstrText, "ä", "ä")
pvstrText = Replace$(pvstrText, "ö", "ö")
pvstrText = Replace$(pvstrText, "ü", "ü")
pvstrText = Replace$(pvstrText, "ß", "ß")
Convert = pvstrText
End Function
Gruß
Nepumuk
Anzeige
AW: Array
23.10.2022 17:00:33
Herbert_Grom
Hallo Nepumuk,
vielen Dank für deinen Code, er funzt perfekt!
Servus
AW: Array
23.10.2022 17:06:30
Herbert_Grom
Hallo Nepumuk,
jetzt habe ich doch noch eine Frage: In der CSV gibt es in der Spalte L Preisangaben. Diese werden aber in der Form "123.45" importiert. Kann man die auch noch beim Import in Dezimalwerte umwandeln?
Servus
AW: Array
23.10.2022 19:15:07
Nepumuk
Hallo Herbert,
teste mal:

Public Sub CSV_importieren()
Const FOR_READING As Long = 1
Const TRISTATE_USEDEFAULT As Long = -2
Dim objFileSystemObject As Object, objFile As Object, objTextStream As Object
Dim astrRows() As String, astrColumns() As String, strText As String
Dim lngRow As Long, ialngIndex As Long
Set objFileSystemObject = CreateObject(Class:="Scripting.FileSystemObject")
Set objFile = objFileSystemObject.GetFile("H:\Mappe1.csv") '                  Pfad anpassen !!!
Set objTextStream = objFile.OpenAsTextStream(FOR_READING, TRISTATE_USEDEFAULT)
strText = objTextStream.ReadAll
Set objTextStream = Nothing
Set objFile = Nothing
Set objFileSystemObject = Nothing
astrRows = Split(strText, vbCrLf)
lngRow = 1
For ialngIndex = LBound(astrRows) To UBound(astrRows)
If Len(Trim$(astrRows(ialngIndex))) > 0 Then
astrColumns = Split(Convert(astrRows(ialngIndex)), ";")
Cells(lngRow, 1).Resize(1, UBound(astrColumns) + 1).Value = astrColumns
lngRow = lngRow + 1
End If
Next
Columns(12).TextToColumns
End Sub
Die Funktion "Convert" nicht löschen!!!
Gruß
Nepumuk
Anzeige
AW: Array
24.10.2022 10:14:30
Herbert_Grom
Hallo Nepumuk,
leider meckert er bei dieser Zeile das "Convert" an. Was kann das sein?

astrColumns = Split(Convert(astrRows(ialngIndex)), ";")
Servus
AW: Array
24.10.2022 10:19:19
Nepumuk
Hallo Herbert,
wie lautet die Fehlermeldung?
Gruß
Nepumuk
AW: Array
24.10.2022 10:28:48
Herbert_Grom
Sorry Nepumuk, wie konnte ich nur an dir zweifeln! Es war mein Fehler, weil ich die "Function Convert" nicht mehr in der AM hatte. So funktioniert es einwandfrei! Vielen Dank!
Servus
AW: Array
23.10.2022 15:47:46
Uduuh
Hallo,
meine Version dazu:

Sub CSV_importieren()
Dim QuellDatei$, Inhalt$
Dim vntIN, vntOUT(), vntTmp, i As Long, j As Long
QuellDatei = "x:\x\x.csv"
Open QuellDatei For Input As #1
'Daten in das Tabellenblatt eintragen
Do While Not EOF(1)
Line Input #1, Inhalt 'Inhalt der QuellDatei zeilenweise einlesen
If Len(Inhalt) Then
vntIN = vntIN & vbCrLf & Inhalt
End If
Loop
Close #1
vntIN = Mid(vntIN, 2)
vntIN = Split(vntIN, vbCrLf)
vntTmp = Split(vntIN, ";")
ReDim vntOUT(UBound(vntIN), 1 To UBound(vntTmp))
For i = 0 To UBound(vntIN)
vntTmp = Split(vntIN(i), ";")
For j = 0 To UBound(vntTmp)
vntOUT(i, j) = vntTmp(j)
Next j
Next i
Sheets("Import").Cells(1, 1).Resize(UBound(vntOUT) + 1, UBound(vntOUT, 2) + 1) = vntOUT
End Sub
Gruß aus'm Pott
Udo
Anzeige
AW: Array
23.10.2022 17:02:20
Herbert_Grom
Hi Udo,
vielen Dank für deinen Code. Er bleibt bei dieser Zeile hängen mit "Typen unverträglich":

  vntTmp = Split(vntIN, ";")
Was passt ihm da nicht?
Servus
AW: Array
23.10.2022 21:11:45
snb

Sub M_snb()
sn = Split(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\sample.csv").readall, vbCrLf)
With CreateObject("scripting.dictionary")
For j = 0 To UBound(sn) - 1
.Item("C_" & .Count) = Split(sn(j), ";")
Next
Cells(1).Resize(.Count, UBound(.Item("C_1")) + 1) = Application.Index(.items, 0, 0)
End With
End Sub

Anzeige
AW: Array
24.10.2022 10:12:26
Herbert_Grom
Hallo snb,
vielen Dank, es funzt perfekt!
Servus
Early Binding Version
25.10.2022 00:23:12
Yal
Moin,
inspiriert vom Code von Nepumuk, schlage ich eine Early Binding Version des Codes. Es muss lediglich in "Extras", "Verweise" die Library "Microsoft Scripting Runtime" angehakt werden.
Seine Funktion "Convert" wird weiterhin gebraucht!

Public Sub CSV_importieren()
'Unter Anbindung  von "Microsoft Scripting Runtime" (VB-Editor, Extras, Verweise, Haken bei "Micros...")
Dim FSO As New FileSystemObject
Dim Datei As TextStream
Dim Inhalt
Dim Elt
Dim Spalten As String
Set Datei = FSO.OpenTextFile("H:\Mappe1.csv")  'Pfad anpassen !!!
Inhalt = Split(Convert(Datei.ReadAll), vbCrLf)
Datei.Close
For Each Elt In Inhalt
Spalten = Split(Elt, ";")
If Ubound(Spalten) >= 11 Then Spalten(11) = Replace(Spalten(11), ".", ",") 'Punkt durch Komma in Spalte L
Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(1, UBound(Spalten) + 1).Value = Spalten
Next
End Sub
VG
Yal
Anzeige
AW: Early Binding Version
25.10.2022 09:54:05
Herbert_Grom
Hallo Yal,
vielen Dank für deinen Vorschlag, aber ich habe mich für den Code von snb entschieden.
Servus

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige