Spalten sortieren

[hubsi]

Hallo Zusammen,

habe eine Excel Datei mit technischen Daten welche alle in einer Zelle stehen und innerhalb der Zelle durch "|" getrennt sind... die einzelnen Werte in Spalten aufzuteilen habe ich geschafft.

Jedoch habe ich das Problem, dass nicht die gleichen Werte in einer Spalter untereinander stehen. Es müsste quasi jeder Wert in einer eigenen Spalte stehen und wenn ein Artikel hier keinen Wert hat, dann sollte das Feld leer bleiben... sonst kann ich diese Werte nicht in mein Programm importieren. Ich komme hier einfach nicht drauf wie ich das vernünftig sortieren kann! Bitte um Hilfe.

Danke vorab.

[steve1da]

Hola,

verlinkst du bitte deine Fragen in den verschiedenen Foren gegenseitig?
Danke.

Gruß,
steve1da

[Fennek]

Hallo Markus,

n.M.E. sind die Daten zu komplex für ein einfaches Text-in-Spalten. Vermutlich wird VBA nötig:

- Für jede Kategorie, z.B. "Verdichtersystem" eine Spalte festlegen
- den Wert mittels Vergleich dieser Spalte zuordnen (z.B. "WDS")

Entspricht das dem für die Weiterverabeitung benötigten Format?

mfg

PS: müssen die Kategorien eine bestimmte Reihenfolge haben?

[Dieter63]

Hallo, 

Spalte markieren -->  Daten -> Text in Spalten

[Kuwer]

Hallo,

teste es mal damit:

Sub TextInSpaltenMitZuordnung_3()
  Dim i As Long, j As Long, k As Long, l As Long
  Dim rngB As Range
  Dim strTemp As String
  Dim varT As Variant, varS As Variant
  Dim varQ As Variant, varZ As Variant
  Dim colSpalten As New Collection
  
  Set rngB = Cells(1).CurrentRegion.Columns(2)
  varQ = rngB.Value
  ReDim varZ(1 To 1, 1 To Application.CountIf(rngB, "*:*") / 2)
  
  On Error Resume Next
  l = 1
  For i = 2 To UBound(varQ)
    varT = Split(varQ(i, 1), "|")
    For j = 0 To UBound(varT)
      varS = Split(varT(j), ": ")
      For k = 0 To 0
        colSpalten.Add CStr(l), CStr(varS(k))
        If Err.Number Then
          Err.Clear
        Else
          varZ(1, l) = varS(k)
          l = l + 1
        End If
      Next k
    Next j
  Next i
  On Error GoTo 0
  
  Cells(1, 2).Resize(1, l).Value = varZ
  
  ReDim varZ(1 To rngB.Rows.Count, 1 To l)
  
  For i = 2 To UBound(varQ)
    varT = Split(varQ(i, 1), "|")
    For j = 1 To UBound(varT)
      varS = Split(varT(j), ": ")
      For k = 0 To 0
        For l = 2 To UBound(varS)
          strTemp = strTemp & ": " & varS(l)
        Next l
        For l = 1 To UBound(varS)
          varZ(i - 1, colSpalten(varS(k))) = "'" & varS(l) & strTemp
          Exit For
        Next l
        strTemp = ""
      Next k
    Next j
  Next i
  
  Cells(1, 2).Resize(UBound(varZ, 1), UBound(varZ, 2)).Offset(1).Value = varZ
  Cells(1).CurrentRegion.Columns.AutoFit
  Cells(1).CurrentRegion.Rows.AutoFit
End Sub

Gruß Uwe

[hubsi]

Danke für die Info. Ich habe jetzt mal eine Datei manuell erstellt wie das Ganze dann "geordnet" aussehen sollte - siehe Anhang. 

Glaube die ursprüngliche Excel Liste kann man mit Power Query dann so ausgeben bzw. so anordnen. Aber ich habe hier leider null Anhang wie das geht.

Bitte daher um eure Hilfe.

Grüße.

[Fennek]

in das die Datei von Günther?

https://www.herber.de/forum/messages/1742707.html

[marose67]

Hallo Fennek,
Ja ....

Gruß
Marcus

[hubsi]

Ja genau. Habe Günther bereits auch geschrieben dass ich es selbst probiert habe, aber mache hier scheinbar was falsch denn das mit dem Spalten sortieren funktioniert nicht bei mir. :(

[snb]

Dieser Code reicht:

Code:

Sub M_snb()
  sn = Filter(Split(Replace(Join(Application.Transpose(Sheet1.Columns(2).SpecialCells(2)), "|"), ": ", ": |"), "|"), ": ")
 
  With CreateObject("scripting.dictionary")
    For j = 0 To UBound(sn)
      If Not .exists(sn(j)) Then .Item(sn(j)) = .Count
    Next
    Sheet3.Cells(1, 2).Resize(, .Count) = .keys
   
    sn = Sheet1.Cells(1).CurrentRegion
    ReDim sq(UBound(sn), .Count + 2)
    For j = 2 To UBound(sn)
      sq(j -2, 0) = sn(j, 1)
      st = Split(Replace(sn(j, 2), ": ", ": |"), "|")
      For jj = 0 To UBound(st) - 1 Step 2
        sq(j -2, .Item(st(jj)) + 1) = st(jj + 1)
      Next
    Next
  End With
 
  Sheet3.Cells(2, 1).Resize(UBound(sq) + 1, UBound(sq, 2) + 1) = sq
End Sub