Large(Bereich,x)-Was tun, wenn 2 Werte gleich?
15.08.2003 22:50:15
Mike E.
indirekt gehört das zwar zu einem älteren Posting, bei dem mir ChrisL sehr geholfen hat, ist jedoch ein anders geartetes Problem, sodass ich hier einen neuen Thread eröffnen möchte.
Problem:
ich ermittle mittels 4 Schleifen jeweils den größten Wert, den zweitgrößten, dritt- u. viertgrößten Wert und hole mir dann jweils den Text der Spalte links daneben in ein anderes Blatt.
Ungünstigen Falles kann es vorkommen, dass ein oder mehr Werte gleich sind und dann bekomme ich falsche oder doppelte Ergebnisse.
Mein Lösungsversuch lässt das Makro eine Enlosschleife ohne Ergebnis durchlaufen.
Was ich versucht habe:
ich schreibe die (im optimalen Fall) 4 Ergebnisse in nebeneinanderliegende Spalten einer Tabelle. Wenn nun in der vorangegangenen Spalte das gleiche steht, wie in der folgenden, soll die gleicher Schleife erneut durchlaufen werden. Bsp.:
For Each zelle In Rng ' Schleife für den größten Wert
If zelle = Application.WorksheetFunction.Large(Rng, 1) Then Worksheets("Test").Cells(a, 6) = Cells(zelle.Row, zelle.Column - 1) & " _ " & zelle
Next zelle
zwei:
For Each zelle2 In Rng ' Schleife für den zweitgrößten Wert
If zelle2 = Application.WorksheetFunction.Large(Rng, 2) Then
If Worksheets("Test").Cells(a, 6) = Worksheets("Test").Cells(a, 7) Then GoTo zwei ' hier soll die Schleife ein zweites Mal durchlaufen werden, wenn zelle = zelle2
Else
Worksheets("Test").Cells(a, 7) = Cells(zelle2.Row, zelle2.Column - 1) & " _ " & zelle2
End If
Next zelle2
drei:
For Each zelle3 In Rng
If zelle3 = Application.WorksheetFunction.Large(Rng, 3) Then
If Worksheets("Test").Cells(a, 7) = Worksheets("Test").Cells(a, 8) Then GoTo drei
Else
Worksheets("Test").Cells(a, 8) = Cells(zelle3.Row, zelle3.Column - 1) & " _ " & zelle3
End If
Next zelle3
vier:
For Each zelle4 In Rng
If zelle4 = Application.WorksheetFunction.Large(Rng, 4) Then
If Worksheets("Test").Cells(a, 8) = Worksheets("Test").Cells(a, 9) Then GoTo vier
Else
Worksheets("Test").Cells(a, 9) = Cells(zelle4.Row, zelle4.Column - 1) & " _ " & zelle4
End If
Next zelle4
Hat vielleicht jemand eine elegantere Lösung? Ich möchte, selbst bei vier gleichen Werten, dass immer der nächste Wert (da die Zelle jeweils links daneben sich immer von der vorangegangenen unterscheidet) ermittelt wird.
Entschuldigt bitte die umständliche Formulierung - ist normalerweise nicht mein Stil...
Vielen Dank und viele Grüße
Mike
P.S.: im Falle einer Antwort, kann die Rückmeldung meinerseizs erst am Montag erfolgen.