Daten in Zeilen in Spalten anordnen

[apocx87]

Moin zusammen,







ich habe eine Liste von Pflegediensten von einer Website kopiert (copy paste). In Excel werden die Adressdaten dann Zeile für Zeile dargestellt. Damit ich "datenbankmäßig" damit arbeiten kann, sollen die Daten in Spaltenform transponiert werden. Wie bekomme ich das ohne Handarbeit hin?





 - siehe Bild -



Danke

[LCohen]

Kannst Du die Daten noch mal als .xlsx anhängen? Bitte nimm 10 Datensätze (also 10 Anbieter, somit mit ungefähr 100 Zeilen) und lösche dahinter alles (aus Datenschutzgründen, auch wenn öffentlich im Web zugänglich). Bitte davor nichts am Webimport ändern!

[apocx87]

Danke
Die Daten sind hier frei verfügbar, daher habe ich an den Daten nichts weiter verändert (https://www.pflegedienst-online.info/Bra...o_seite=50&umkreis=100&page=0)

[LCohen]

  Pflege.xlsx (Größe: 17,41 KB / Downloads: 6)

Grün: Datensatznummer-Anker
Gelb: Versatz der Daten dazu, in Spalten und Zeilen
Hellblau: Zugriff auf die Daten gemäß Versatz
Dunkelblau: Wechsel der Überschrift aufgrund variabler Zeilenfolge (als Sonderfall zu Hellblau)

Du kannst nun ein zweites Blatt einfügen und den farbigen Bereich en bloc ausschneiden und dort einfügen

Keine Gewähr für absolute Genauigkeit, da für Webimporte nie garantiert werden kann. Felizitas Häusl bspw. ist nicht dabei, mangels Tel.-nr.

[apocx87]

Wahnsinn, danke dir. Im Leben wäre ich da nicht drauf gekommen.... DANKE

[atilla]

Hallo zusammen,

die Aufgabe fand ich auch sehr Interessant.
Auf die Formellösung von LCohen wäre ich auch nicht so schnell gekommen, vielleicht in ein paar Monaten.

Dafür habe ich eine VBA Lösung, die etwas genauer arbeitet und aufteilt.
Vorgegeben sind zwei Tabellen.
Tabelle1 mit der WEB-Liste. Der erste Name bzw. die erste Firmenbezeichnung taucht in Zeile 3 auf.
Da der Inhalt der Spalte 3 nicht berücksichtigt wird, nutze ich dies als Hilfsspalte.
Geschrieben wird in Tabelle2

Wenn diese Vorgaben erfüllt sind, dann unten stehenden Code ausführen:

Code:

Option Explicit

Sub Spalte_in_Gruppen_transponieren()
   Dim i As Long, j As Long, n As Long
   Dim lngZ As Long
   Dim arrText
   Dim feld
   Dim arr()
   Dim cKey
   Dim cO As Object
   Set cO = CreateObject("Scripting.Dictionary")
 
   With Sheets("Tabelle1")
      lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range(.Cells(3, 3), .Cells(lngZ, 3)).FormulaLocal = "=WENN(A3=" & """Mehr Information""" & ";C2+1;C2)"
      feld = .Range(.Cells(1, 1), .Cells(lngZ, 3))
      For i = 3 To lngZ - 1
         If feld(i, 1) <> "Mehr Information" Then
            cKey = feld(i, 3)
            If feld(i, 1) <> "" And feld(i, 2) = "" Then
               cO(cKey) = cO(cKey) & "|" & feld(i, 1)
            ElseIf feld(i, 2) <> "" Then
               cO(cKey) = cO(cKey) & "|" & feld(i, 1) & "$" & feld(i, 2)
            End If
         End If
     Next i
    
     ReDim arr1(cO.Count, 5)
     For Each cKey In cO
      arrText = Split(Replace(cO(cKey), "|", "", 1, 1), "|")
      arr1(j, 0) = arrText(0) 'Bezeichnung
      For n = LBound(arrText) + 1 To UBound(arrText)
         If arrText(n) Like "Tel*$*" Then
            arr1(j, 4) = Split(arrText(n), "$")(1) 'Tel
         ElseIf arrText(n) Like "Fax*$*" Then
            arr1(j, 5) = Split(arrText(n), "$")(1) 'Fax
         ElseIf arrText(n) Like "#*" Then
            arr1(j, 3) = arrText(n) 'PLZ Ort
         ElseIf arrText(n) Like "*#*" Then
            arr1(j, 2) = arrText(n) 'straße
         Else
            arr1(j, 1) = arrText(n) 'Name
         End If
      Next n
      j = j + 1
     Next
     .Range(.Cells(3, 3), .Cells(lngZ, 3)).ClearContents
   End With

  With Sheets("Tabelle2")
    lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Range("A2:F" & lngZ).ClearContents
    .Cells(2, 1).Resize(j, 6).Value = arr1
  End With

End Sub

Unten stelle ich die Beispielmappe ein.
Dort braucht nur die Tabelle2 aktiviert werden, dann wird der Code automatisch ausgeführt.


  Spalte In Gruppen Transponieren.xlsm (Größe: 34,57 KB / Downloads: 1)