Matrixerzeugung aus einer abgelegten Liste
simo
ich möchte aus einer liste eine matrix mit werten erstellen. ich habe dazu ein bisschen rumgeströbert und dabei diesen code gefunden:
https://www.herber.de/forum/ _
archiv/296to300/t298023.htm Sub Rudiger() Dim i As Long, ii As Long, iii As Long Dim WS1 As Worksheet, WS2 As Worksheet Set WS1 = Worksheets("Tabelle1") Set WS2 = Worksheets("Tabelle2") WS2.Cells.ClearContents For i = 1 To WS1.Range("A65536").End(xlUp).Row If WorksheetFunction.CountIf(WS2.Range("A1:A" & WS2.Range("A65536").End(xlUp).Row), WS1. _ Cells(i, 1)) = 0 Then WS2.Cells(WS2.Range("A65536").End(xlUp).Row + 1, 1) = WS1.Cells(i, 1) If WorksheetFunction.CountIf(WS2.Range("B1", WS2.Cells(1, WS2.Range("IV1").End(xlToLeft) _ .Column)), WS1.Cells(i, 2)) = 0 Then WS2.Cells(1, WS2.Range("IV1").End(xlToLeft).Column + 1) = WS1.Cells(i, 2) WS2.Cells(WS2.Range("A65536").End(xlUp).Row, WS2.Range("IV1").End(xlToLeft).Column)= _ "x" Else For iii = 2 To WS2.Range("IV1").End(xlToLeft).Column If WS2.Cells(1, iii) = WS1.Cells(i, 2) Then Exit For Next iii WS2.Cells(WS2.Range("A65536").End(xlUp).Row, iii) = "x" End If Else For ii = 1 To WS2.Range("A65536").End(xlUp).Row If WS2.Cells(ii, 1) = WS1.Cells(i, 1) Then Exit For Next ii If WorksheetFunction.CountIf(WS2.Range("B1", WS2.Cells(1, WS2.Range("IV1").End(xlToLeft) _ .Column)), WS1.Cells(i, 2)) = 0 Then WS2.Cells(1, WS2.Range("IV1").End(xlToLeft).Column + 1) = WS1.Cells(i, 2) WS2.Cells(ii, WS2.Range("IV1").End(xlToLeft).Column) = "x" Else For iii = 2 To WS2.Range("IV1").End(xlToLeft).Column If WS2.Cells(1, iii) = WS1.Cells(i, 2) Then Exit For Next iii WS2.Cells(ii, iii) = "x" End If End If Next i End Sub
dieser bewirkt eine X-Setzung bei 2 parametern.
meine liste sieht wie folgt aus:
f01 f02
0 1
f01 f03
0 1
f01 f04
1 0
f02 f03
1 0
f04 ....
....
als ausgabe wäre eine matrix super, in der das über der "1" stehende Wort in die matrix geschrieben wird,
also
f02 f03 f04
----------------------
f01 f02 f03 ...
f02 f02
ich habe schon ein bisschen rumprobiert, allerdings kam nichts brauchbares raus. hat jemand rat ?
vielen dank im vorraus.