Sub
Neuer_Import_CSV()
Dim
strFileName
As
String
, arrDaten, arrTmp, lngR
As
Long
, lngLast
As
Long
Const
cstrDelim
As
String
=
";"
With
Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect =
False
.Title =
"Datei wählen"
.InitialFileName =
"\*.csv"
If
.Show = -1
Then
strFileName = .SelectedItems(1)
End
If
End
With
Rows(
"6:99999"
).
Select
Selection.Delete Shift:=xlUp
Rows(
"5:5"
).
Select
Selection.ClearContents
If
strFileName <>
""
Then
Application.ScreenUpdating =
False
Open strFileName
For
Input
As
#1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For
lngR = 1
To
UBound(arrDaten)
arrTmp = Split(arrDaten(lngR), cstrDelim)
If
UBound(arrTmp) > -1
Then
With
ActiveSheet
lngLast = .Cells(Rows.Count, 1).
End
(xlUp).Row + 1
lngLast = Application.Max(lngLast, 5)
.Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
End
With
End
If
Next
lngR
End
If
Rows(
"5:5"
).
Select
Selection.Delete Shift:=xlUp
Range(
"K65"
).
Select
Sheets(
"Auswertung"
).PivotTables(
"Pivot_Auswertung"
).PivotCache.Refresh
End
Sub
*******************************************************************************************
Sub
CSV_Daten_am_Ende_hinzufügen()
Dim
strFileName
As
String
, arrDaten, arrTmp, lngR
As
Long
, lngLast
As
Long
Const
cstrDelim
As
String
=
";"
With
Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect =
False
.Title =
"Datei wählen"
.InitialFileName =
"\*.csv"
If
.Show = -1
Then
strFileName = .SelectedItems(1)
End
If
End
With
If
strFileName <>
""
Then
Application.ScreenUpdating =
False
Open strFileName
For
Input
As
#1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For
lngR = 1
To
UBound(arrDaten)
arrTmp = Split(arrDaten(lngR), cstrDelim)
If
UBound(arrTmp) > -1
Then
With
ActiveSheet
lngLast = .Cells(Rows.Count, 1).
End
(xlUp).Row + 1
lngLast = Application.Max(lngLast, 5)
.Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
End
With
End
If
Next
lngR
End
If
Rows(
"5:5"
).
Select
Selection.Delete Shift:=xlUp
Range(
"K65"
).
Select
Sheets(
"Auswertung"
).PivotTables(
"Pivot_Auswertung"
).PivotCache.Refresh
End
Sub