Komplexer Datensatz CSV in einfache Filterstruktur umwandeln

[retwa]

Guten Tag

Ich habe eine Testdatensatz. Dieser ist nicht in Spalten geordnet sondern immer vor dem Testresultat steht eine "Testbeschreibung". Teilweise auch Retestdaten, welche einfach anschliessend nochmals angefügt wurden. Mit Pivot schein ich nicht ans Ziel zu kommen. Ich möchte das ganze in eine einfach Filtertabelle umwandeln.

Könnt ihr mit bitte einen Tipp geben wie ich das hinbekommen könnte. Ggf. Anweisungen, Tutorials etc.

Bitte schaut euch das Attachment an.

Herzlichen Dank.

[WillWissen]

Hi,

erstelle bitte eine Beispieldatei, in der du ein paar Wunschergebnisse händisch einträgst.

[Der Steuerfuzzi]

Hallo,

ich könnte mir vorstellen, dass das mit PowerQuery funktionieren könnte.

[retwa]

An bei die geforderte Datei, hoffe stimmt so. Sonst bitte nochmals melden.

Das mit dem PowerQuery, werde ich mich einlesen.

[snb]

Code:

Sub M_snb()
  sn = Split(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\__csv.txt").readall, vbCrLf)
    
  For j = 0 To UBound(sn) - 1
    st = Split(sn(j), ",")
    If j = 0 Then
      ReDim sp(UBound(sn) + 1, UBound(st))
      For jj = 3 To UBound(st) Step 2
        sp(0, 2 + jj \ 2) = st(jj)
      Next
    End If
    sp(j + 1, 0) = st(0)
    sp(j + 1, 1) = st(1)
    sp(j + 1, 2) = st(2)
    For jj = 4 To UBound(st) Step 2
      sp(j + 1, 2 + jj \ 2 - 1) = st(jj)
    Next
  Next
    
  Sheet1.Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

[Jockel]

...

Das mit dem PowerQuery, werde ich mich einlesen.

Hallo, ja mach das... Kann das sein, dass deine csv keine Überschrift(en) hat..?

[retwa]

Code:

Sub M_snb()
  sn = Split(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\__csv.txt").readall, vbCrLf)
    
  For j = 0 To UBound(sn) - 1
    st = Split(sn(j), ",")
    If j = 0 Then
      ReDim sp(UBound(sn) + 1, UBound(st))
      For jj = 3 To UBound(st) Step 2
        sp(0, 2 + jj \ 2) = st(jj)
      Next
    End If
    sp(j + 1, 0) = st(0)
    sp(j + 1, 1) = st(1)
    sp(j + 1, 2) = st(2)
    For jj = 4 To UBound(st) Step 2
      sp(j + 1, 2 + jj \ 2 - 1) = st(jj)
    Next
  Next
    
  Sheet1.Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

Vielen Dank für den VBA Code. Ich denke das ist der Weg den ich gehen muss. Dein Code macht schon vieles Richtig. Leider berücksichtig er nicht, dass unterschiedliche Produkte nicht alle Spalten haben. Des weiteren auch gleiche Tests (Testwiederholungen) Zusätzlich dargestellt werden müssten.

Ich werde darauf aufbauen oder PowerQuery weiter vertiefen.

Merci

[retwa]

Hallo, ja mach das... Kann das sein, dass deine csv keine Überschrift(en) hat..?

Richtig. Das ist ja die "Schwäche" resp. das Problem. Ein Problem von vielen.

[WillWissen]

Hi,

Richtig. Das ist ja die "Schwäche" resp. das Problem. Ein Problem von vielen.

kennst du den Ersteller der csv-Datei? Dann wäre es vllt. der einfachste Weg, dich mit der Person in Verbindung zu setzen und um Spaltenbezeichnungen zu bitten.

[Kuwer]

Hallo retwa,

teste es mal mit folgendem Code:

Modul Modul5

Option 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