PDA

Vollständige Version anzeigen : Liste durchsuchen und ALLE Werte ausgeben


Reinik85
06.09.2011, 15:22
Servus,

ich habe folgendes Problem: Ich habe eine Exceldatei in welcher in einer Spalte Auftragsnummern stehen und in einer anderen Artikelnummern der einzelnen Bestandteile.
Also z.B. Auftrag A123 und dieser besteht aus den Artikel 123, 562 und 345. Die Aufträge können von einem bis zu mehreren dutzend Artikel enthalten.

Sieht in etwa so aus:

Auftragsnummer / Artikelnummer

A123 / 123
A123 / 345
A123 / 456

A456 / 456
A456 / 123

A789 / 345
A789 / 777

Ich möchte ein Schmigalla durchführen und muss dazu wissen welcher Artikel wie oft mit anderen Artikeln in einem Auftrag vorkommt.
Also in diesem Beispiel das z.B. die Artikel 123 und 456 zweimal im selben Auftrag vorkommen und 345 jeweils einmal mit 123, 456 und 777.
Natürlich ist das ganze Komplizierter, ich habe 300.000 Aufträge und 2.800 Artikel, daher kann ich das unmöglich von Hand durchführen.

Gibt es eine Möglichkeit die Tabelle zu durchsuchen, z.B. nach einem Artikel und dann alle Aufträge anzeigen zu lassen in denen dieser vorkommt?

Oder gibt es vielleicht sogar die Möglichkeit folgende Darstellung zu erreichen:

--x-- | 123 | 345 | 456 | 777 |
123 |---- |--- 1 |--- 2 |--- 0 |
345 |--- 1 |---- |--- 1 |--- 1 |
456 |--- 2 |---1 |---- |--- 0 |
777 |--- 0 |---1 |--- 0 |---- |

Also das ich die Anzahl des gemeinsamen Vorkommens erhalte?

Hoffe ist das richtige Unterforum und vielen Dank schon mal.

josef e
06.09.2011, 19:10
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ?

was zum Teufel ist ein <i>"Schmigalla"</i> ?

Zur Lösung deines Problems, solltest du eine Beispieldatei mit der von dir gewünschten Darstellung hochladen.


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

AKTools
07.09.2011, 08:25
Beispieldatei würde ich auch gut finden.
Aber hier schonmal eine erste Idee. Du könntest dir einfach eine Pivot erstellen.
Wobei die Spalten Artikel 1 und Artikel 2 den identischen Inhalt haben. Musste ich nur so aufteilen um zwei Felder zu bekommen die ich jeweisl in die Zeiloen und Spalten felder der Pivot ziehen konnte.

Reinik85
11.09.2011, 15:22
Hallo zusammen,

Schmigalla ist ein Verfahren aus der Fabrik Layout Planung. Kurz gesagt werden nach Schmigalla Maschinen welche die höchsten Materialflüsse unter einander haben am nächsten zu einander angeordnet um die Transportkosten zu minimieren.

@AKTools:
Danke für den Vorschlag allerdings zählt dieser nur jeweils das Gesamtvorkommen, funktioniert aber nicht bei 2 unterschiedlichen Artikeln ;-)

CitizenX
11.09.2011, 19:24
Hi,

probier mal das:

Code in ein allgemeines Modul


Option Explicit

Sub Werte()
Dim Bereich As Range, inZelle As Range
Dim i As Long, x As Long, y As Long
Dim ArtikelArray(), AuftragArray(), myArray()
Dim oShtWerte As Worksheet, oShtAusgabe As Worksheet
Dim oDict As Object
Dim myFind, firstAddress

Set oShtWerte = Sheets("Tabelle2") 'ggf anpassen
Set oShtAusgabe = Sheets("Tabelle3") 'ggf anpassen
Set Bereich = Intersect(oShtWerte.UsedRange, oShtWerte.Range("A:B")) 'ggf anpassen der Spalten

Set oDict = CreateObject("scripting.dictionary")

ReDim ArtikelArray(Bereich.Columns(2).SpecialCells(xlCellTypeConstants).Count)

For Each inZelle In Bereich.Columns(2).SpecialCells(xlCellTypeConstants)
If Not oDict.Exists(inZelle.Value) Then
oDict.Add inZelle.Value, 0
ArtikelArray(i) = inZelle
i = i + 1
End If
Next

ReDim Preserve ArtikelArray(i - 1)
oDict.RemoveAll
i = 0

ReDim AuftragArray(Bereich.Columns(1).SpecialCells(xlCellTypeConstants).Count)

For Each inZelle In Bereich.Columns(1).SpecialCells(xlCellTypeConstants)
If Not oDict.Exists(inZelle.Value) Then
oDict.Add inZelle.Value, 0
AuftragArray(i) = inZelle
i = i + 1
End If
Next

ReDim Preserve AuftragArray(i - 1)
ReDim myArray(UBound(AuftragArray) + 1, UBound(ArtikelArray) + 1)

For x = LBound(AuftragArray) To UBound(AuftragArray)
myArray(x + 1, 0) = AuftragArray(x)
For y = LBound(ArtikelArray) To UBound(ArtikelArray)
myArray(0, y + 1) = ArtikelArray(y)
Set myFind = Bereich.Find(AuftragArray(x), LookIn:=xlValues, lookat:=xlWhole)
firstAddress = myFind.Address
Do
If myFind.Offset(, 1) = ArtikelArray(y) Then myArray(x + 1, y + 1) = 1: Exit Do
Set myFind = Bereich.FindNext(myFind)
Loop While myFind.Address <> firstAddress
Next y
Next x

oShtAusgabe.UsedRange.Clear
oShtAusgabe.Cells(1, 1).Resize(UBound(AuftragArray) + 2, UBound(ArtikelArray) + 2) = myArray

Set oShtWerte = Nothing
Set oShtAusgabe = Nothing
Set Bereich = Nothing
Set oDict = Nothing

End Sub

Reinik85
18.09.2011, 12:18
Vielen Dank für die Mühe.

Leider kommt an der Stelle ein Fehler:
ReDim ArtikelArray(Bereich.Columns(2).SpecialCells(xlCellTypeConstants).Count)

CitizenX
18.09.2011, 18:48
Hi,

wie die Variable schon sagt musst du sie wahrscheinlich anpassen.

ReDim ArtikelArray(Bereich.Columns(2).SpecialCells(xlCellTypeConstants).Count)

For Each inZelle In Bereich.Columns(2).SpecialCells(xlCellTypeConstants)

Spalte 2 stehen die Artikel

ReDim AuftragArray(Bereich.Columns(1).SpecialCells(xlCellTypeConstants).Count)

For Each inZelle In Bereich.Columns(1).SpecialCells(xlCellTypeConstants)

in Spalte 1 stehen die Auftragsnummern

P.S..hast du hier (http://www.office-loesung.de/index3.php) schon eine Lösung bekommen?