Login

***flex001*** · 09.05.2017, 16:14

Hallo zusammen,

vorweg: Ich habe keine wirklichen Excel-Kenntnisse dafür aber eine kleine Aufgabe im Büro bekommen.

Wir haben ein Excel-File mit ca. 300 Spalten und 1.000 Zeilen, bei welchen Kunden (Zeilen) bestimmte Eigenschaften (Spalten) zugeordnet sind.
Dies geschieht aktuell über ein "x" in der jeweiligen Zelle.

Zum Import ins ERP benötigen wir nun eine Liste, in welcher die Zuordnung untereinander erfolgt, d.h.

Vorher:
                 Eigenschaft 10    Eigenschaft 20   Eigenschaft 30
Kunde A                                     x
Kunde B              x                                              x
Kunde C                                     x                       x

Nacher:

Kunde A            20
Kunde B            10
Kunde B            30
Kunde C            20
Kunde C            30

Hat jemand einen Tipp für mich, wie ich die obere in die untere Form bekomme?

Vielen lieben Dank.

shift-del · 09.05.2017, 16:21

atilla · Registriert seit: 14.04.2014 Version(en): 2003, 2007

Hallo,

von mir eine VBA Lösung von mir: :19:

Code:
Sub umstellen()
  Dim i As Long, j As Long, lngZ As Long, lngS As Long
  Dim k As Long
  Dim strgMarker As String
  
  Dim wksQuelle As Worksheet
  Dim wksZiel As Worksheet
  
  Dim arr As Variant
  Dim arrOut()
  Dim D1 As Object
  Dim varK
  Set D1 = CreateObject("Scripting.Dictionary")
  
  strgMarker = "x"
  
  Set wksQuelle = Worksheets("Tabelle2")  'Quelltabelle
  Set wksZiel = Worksheets("Tabelle3")    'Zieltabelle in der die Daten umgestellt reingeschrieben werden
  
  With wksQuelle
    lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
    lngS = .Cells(1, .Columns.Count).End(xlToLeft).Column
    k = Application.CountIf(.Range(.Cells(1, 1), .Cells(lngZ, lngS)), strgMarker)
    arr = .Range(.Cells(1, 1), .Cells(lngZ, lngS))
    
    For i = 2 To UBound(arr)
      For j = 2 To UBound(arr, 2)
        If arr(i, j) = strgMarker Then D1(arr(i, 1)) = D1(arr(i, 1)) & "|" & arr(1, j)
      Next j
    Next i
    
    ReDim arrOut(k - 1, 1)
    k = 0
    
    For Each varK In D1.Keys
      For j = 1 To UBound(Split(D1(varK), "|"))
        arrOut(k, 0) = varK
        arrOut(k, 1) = Split(D1(varK), "|")(j)
        k = k + 1
      Next j
    Next
  End With
  
  With wksZiel 'schreiben in Zieltabelle
    .Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    .Range("A2:B2").Resize(k) = arrOut
  End With
  
  D1.RemoveAll
  Set D1 = Nothing
  Set wksQuelle = Nothing
  Set wksZiel = Nothing

End Sub

Zum Verständnis, so sehen die daten vorher aus:

Arbeitsblatt mit dem Namen 'Tabelle2'
	A	B	C	D
1		10	20	30
2	Kunde A		x
3	Kunde B	x		x
4	Kunde C		x	x

und so hinterher:

Arbeitsblatt mit dem Namen 'Tabelle3'
	A	B
1	Kunde	Wert
2	Kunde A	20
3	Kunde B	10
4	Kunde B	30
5	Kunde C	20
6	Kunde C	30

Login
Benutzername:
Passwort:	Passwort vergessen?
	Merken