Hallo retwa,
teste es mal mit folgendem Code:
Modul Modul5Option Explicit
Sub ImportCSV()
Dim i As Long, j As Long, k As Long
Dim rngQ As Range, rngT As Range
Dim varT As Variant, varQ As Variant, varZ As Variant
Application.ScreenUpdating = False
Workbooks.OpenText Filename:="C:\Users\Kuwer\Documents\Excel\Test\csv.txt", _
Origin:=1252, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False
Set rngQ = ActiveSheet.Cells(1).CurrentRegion
rngQ.Cells(1).Offset(rngQ.Rows.Count + 1) = "..."
For i = 1 To rngQ.Rows.Count
For j = 4 To rngQ.Columns.Count Step 2
If Len(rngQ(i, j).Value) Then
If Not rngT Is Nothing Then
If rngQ(i, j).Value = rngQ(i, j - 2).Value Then
k = k + 1
rngQ(i, j).Value = rngQ(i, j).Value & String(k, " ")
Else
k = 0
End If
Set rngT = Application.Union(rngT, rngQ(i, j))
Else
Set rngT = rngQ(i, j)
End If
Else
k = 0
Exit For
End If
Next j
If Not rngT Is Nothing Then
rngT.Copy
rngQ.Parent.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Transpose:=True
Set rngT = Nothing
End If
Next i
rngQ.Replace "...", ""
varQ = rngQ.Value
rngQ(1, 1).Value = "Product"
rngQ(1, 2).Value = "Date"
rngQ(1, 3).Value = "Time"
With rngQ.Parent.Cells(Rows.Count, 1).End(xlUp).CurrentRegion
.RemoveDuplicates Columns:=1, Header:=xlNo
.Replace "...", ""
.Sort Key1:=.Cells(1), Order1:=xlAscending
.Copy
rngQ(1, 4).PasteSpecial Transpose:=True
.EntireRow.Delete
End With
Redim varZ(1 To Ubound(varQ, 1), 1 To Application.Min(Columns.Count - 3, Ubound(varQ, 1) * Ubound(varQ, 2)))
For i = 1 To Ubound(varQ, 1)
varZ(i, 1) = varQ(i, 1)
varZ(i, 2) = varQ(i, 2)
varZ(i, 3) = varQ(i, 3)
For j = 4 To Ubound(varQ, 2) Step 2
If Len(varQ(i, j)) Then
varZ(i, Application.Match(varQ(i, j), rngQ.Rows(1), 0)) = varQ(i, j + 1)
Else
Exit For
End If
Next j
Next i
With rngQ
.Rows(.Rows.Count).Copy
.Rows(.Rows.Count + 1).PasteSpecial -4122
.Cells(2, 1).Resize(Ubound(varQ, 1), Ubound(varQ, 2)).Value = varZ
.Cells(1).Select
End With
Application.CutCopyMode = False
End Sub
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0
Gruß Uwe