AW: Höchste Anzahl mehrfacher Werte
06.06.2013 13:35:08
Jackd
Hallo Rudi
Also du hast mir ja ne ganz schöne Aufgabe gestellt =)
Ich bin jetzt zu weiten Teilen durch den Code und hab auch bissl was verstanden.. =)
Vielleicht schaffst du es mal drüber zu schauen, und meine Notizen zu "würdigen" bzw. zu korrigieren
For Each rngC In rngA.Columns(1).Cells
Schleife
If rngC.Offset(, 2) = "Erstauftrag" Then 'Erstauftrag
Abfrage1: ob in Spalte +2 der Werrt Erstauftrag steht
If objKd.exists(rngC.Value) Then 'Kunde schon gelesen
Abfrage1:positiv Abfrage2: ob Objekt Kunde schon existiert
arrTmp = objKd(rngC.Value)
Abfrage1 & 2: positiv (Codezeile bekomm ich allerdings nicht aktiviert bzw. diese Zwei Bedingungen werden nicht erfüllt) ...?
ReDim arrNeu(UBound(arrTmp) + 2)
Neudimensionierung / Neuanlegen eines Array was 2 Werte Größer als das temporäre Array ist (das müsste hier nur mit der Kundennummer Gefüllt sein)
arrNeu(0) = arrTmp(0)
Übertrag der Kundennummer von Temp auf ArrayNeu
arrNeu(1) = rngC.Offset(, 1).Value
arrNeu(2) = rngC.Offset(, 2).Value
For i = 1 To UBound(arrTmp)
arrNeu(i + 2) = arrTmp(i)
Next
bis hierhin hat der Code bei mir keine Funktion, zumindest nicht erkennbar für mich
objKd(rngC.Value) = arrNeu
ObjKunde mit Werten aus dem neuen Array belegen
iMax = WorksheetFunction.Max(iMax, UBound(arrNeu))
Prüfen ob array größer oder iMAx und dann den größeren weiter geben
Else 'neuer Kunde
Abfrage1: positiv Abfrage2:negativ
objKd(rngC.Value) = Array(rngC.Value, rngC.Offset(, 1).Value, rngC.Offset(, 2).Value)
Objekt kunden Mit Werten Füllen (Kundennummer, Auftrag, Auftragsnummer)
iMax = WorksheetFunction.Max(iMax, 2)
Warum ist das max hier erneut? es legt ja nur das iMax auf mindestens 2 Fest
End If
Else
Abfrage1: negativ
If objKd.exists(rngC.Value) Then
Abfrage 2:
arrTmp = objKd(rngC.Value)
temporäres Array mit 1 Kundennummer füllen
ReDim arrNeu(UBound(arrTmp) + 1)
neues Array (eins größer als temp. Array)
For i = 0 To UBound(arrTmp)
arrNeu(i) = arrTmp(i)
Next
Übetragen von tempArr in neuesArr
arrNeu(UBound(arrNeu)) = rngC.Offset(, 1).Value
Hinzufügen neue Auftragsart ?
objKd(rngC.Value) =arrNeu
iMax = WorksheetFunction.Max(iMax, UBound(arrNeu))
Else
objKd(rngC.Value) = Array(rngC.Value, rngC.Offset(, 1))
iMax = WorksheetFunction.Max(iMax, 1)
End If
End If
Next rngC
'
Hier seh ich nicht richtig durch
arrItems = objKd.items
Zählen aller Kundennummern (ohne Dubletten?)
ReDim arrNeu(1 To UBound(arrItems) + 2, 1 To iMax + 1)
'Überschriften
arrNeu(1, 1) = "Kundennummer"
arrNeu(1, 2) = "Auftrag"
arrNeu(1, 3) = "Auftragsart"
ArrayNeu neu dimensionieren und in die erste "zeile" die Überschriften einfügen
For i = 4 To UBound(arrNeu, 2)
arrNeu(1, i) = "Folgeauftrag"
Next
"breite" des array nutzen um Folgeaufträge in die Spalte 4 ff zu schreiben könnte man hier nicht auch iMax nehmen?
'Daten in Array schreiben
For i = 0 To UBound(arrItems)
arrTmp = arrItems(i)
Zeilen füllen
For j = 0 To UBound(arrTmp)
arrNeu(i + 2, j + 1) = arrTmp(j)
Next
Spalten füllen
Next
Auftraege = arrNeu
Rückgabe der Werte an die Sub
End Function
Vielen Dank
und Grüße