ich möchte per Makro den Inhalt einer CSV-Datei aufaddieren und in Spalten ausgeben. Bevor ich hier zuviel erkläre, hier ein Beispiel:
Dies ist die Struktur meiner Importdatei:
Ort;NAM;WT;FLE;GROE;ENT;GRB;BU;BUA;NANU;ANT;EIT;ASCH
WD;0112;1;3;3648;;0184-0000698;0006;KLH;0001.00.00.00.00;;;
WD;0112;2;4;34077;;0075-0000065;0007;KLH;0003.00.00.00.00;;;
WD;0112;2;5/1;8393;;0075-0000065;0007;KLH;0003.00.00.00.00;;;
WD;0150;1;2;7000;;0045-0004572;0007;KLH;0003.00.00.00.00;;;
WD;0184;1;13;3530;;0184-0000299;0285;KLH;0022.00.00.00.00;;;
WD;0184;1;14;51376;;0184-0001309;0003;KLH;0001.00.00.00.00;;;
WD;0184;2;22;22343;;0112-0000214;0002;KLH;0001.00.00.00.00;;;
WD;0184;2;30;9203;;0184-0000299;0285;KLH;0022.00.00.00.00;;;
WD;0184;2;31;41035;;0112-00000WD;0036;KLH;0005.00.00.00.00;;;
WD;8075;269;12;18968;;0112-0000076;0055;KLH;0000.00.00.00.00;;;
WD;8075;269;13;800;;8075-0000162;0008;KLH;0001.00.00.00.00;;;
WD;8075;269;14;2613;;0184-0000299;0274;KLH;0022.00.00.00.00;;;
WD;8119;14;37/4;6814;;8119-0000262;0003;KLH;0000.00.00.00.00;;;
WD;8119;14;37/5;20805;;8119-0000326;0061;KLH;0002.00.00.00.00;;;
WD;8119;14;37/6;3984;;8119-0000354;0074;KLH;0001.00.00.00.00;;;
Immer wenn "NAM" & "WT" (zur Zeile darüber) gleich ist, dann soll "GROE" aufaddiert werden. Wenn nicht, dann neue Zeile und das gleiche Spiel von vorne. Bei den Daten oben sollte also dieses Ergebnis in meinen Excelspalten rauskommen:
NAM WT GROE
0112 1 3648
0112 2 42470
0150 1 7000
0184 1 54906
0184 2 72581
8075 269 22381
8119 14 31603
Hier mein Testmakro:
Sub CSVImport()
'CSV-Import
Dim ws As Worksheet
Dim strSrcFile$, strTmp$, strDelimit$
Dim intFile%, i&, k&, arrsrc
Dim lngLast As Long
Dim suche As String
Dim mbox As Byte
'#####Testecke#####
Dim OldVal As String
Dim GROE As Double
Dim Zahl As Integer
OldVal = "0000"
GROE = 0
'#####Test ende#####
strDelimit = ";"
intFile = FreeFile
'Öffnen-Dialog
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = ""
.Filters.Add "CSV-Dateien", "*.csv", 1
.Filters.Add "Alle Dateien", "*.*", 2
If .Show Then
strSrcFile = .SelectedItems(1)
End If
End With
If strSrcFile "" Then
'Suche
suche = "WD"
'lngLast = Zähler 1. Zeile
lngLast = 1
Set ws = ThisWorkbook.ActiveSheet
'Datenimport
Open strSrcFile For Input As #intFile
Do While Not EOF(intFile)
Line Input #intFile, strTmp
If lngLast = 1 Then
If InStr(1, strTmp, suche, vbTextCompare) > 0 Then
'Suchbegriff gefunden! lngLast = Zeilenzähler
lngLast = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
lngLast = Application.Max(lngLast, 4)
Else
'Suchbegriff nicht gefunden
Exit Do
End If
Else
arrsrc = Split(strTmp, strDelimit, -1, vbTextCompare)
'####Test####
With ws
If OldVal arrsrc(1) Then
OldVal = arrsrc(1)
Else
Zahl = arrsrc(5)
GROE = GROE + Zahl
End If
'####Test####
'Cells(lngLast, 1) = arrSrc(0)
End With
'lngLast = lngLast + 1
End If
Loop
'CSV schließen
Close #intFile
Set ws = Nothing
End If
End Sub
Ist mein Vorhaben überhaupt direkt im Makro möglich, oder würdet ihr mir den Weg über eine "Aufbereitung" in Excel per Hilfsspalten/Filter raten? Ich würde mich über Rückmeldung freuen :-)LG,
Manu