Matrix erstellen

Hallo,
habe nun ein größeres Problem und stehe wie ein Ochse vor'm Berg:
Ich habe in Tabelle 1 eine 2-Spalten breite Tabelle mit 3482 Zeilen. In Spalte A steht die Materialbezeichnung, in Spalte B steht die Ortsbezeichnung, wo sich das Material befindet.
In etwa so:
material ortsnummer
a 10
b 10
d 10
a 11
d 11
a 12
... ...
Eine Materialart kann sich also an mehreren Orten befinden.
In Tabelle 2 will ich nun eine Matrix erstellen:
In Spalte A stehen die Materialbezeichnungen, in Zeile 1 stehen die Ortsnummern. In der Matrix soll nun an den Schnittpunkten immer dann ein "X" stehen, wenn ein Material an einem Ort vorhanden ist.
Nach meinem Beispiel soll das ganze dann so aussehen:
___10____11____12
a___x_____x_____x
b___x
c
d___x_____x
Gibt es hier eine Möglichkeit (mit Makro oder Formel), wie ich das ganze schnell realisieren kann?
Danke und viele Grüße
Rüdiger

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Matrix erstellen

21.08.2003 13:39:30

ChrisL

AW: Matrix erstellen

21.08.2003 13:47:14

Stephan

AW: Matrix erstellen

21.08.2003 15:07:42

rüdiger

Hi Rüdiger
https://www.herber.de/bbs/user/662.xls
Option Explicit


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

Gruss
Chris

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread