Neuer Versuch - VBA-Lösung gesucht
14.09.2016 09:22:35
Bernd
Ich versuche es erneut eine Lösung auf mein Problem zu bekommen, da der letzte Thread nicht mehr beachtet wurde. Das war meine letzte Frage auf die erste VBA-Lösung:
[...]Jedoch stimmen die rot markierten Werte nicht mit den 10% überein.
Und zwar wurde der wert in der Bsp. Mappe "110" rot markiert. Wenn man aber die 10% auf die 100 _
drauf rechnet, kommen ja 110 bei raus und dementsprechend sollte der Wert nicht rot markiert werden.
Wenn man das Spiel weiter spielt und von den 110 die 10% wieder drauf rechnet, sollte der nä _
chste Wert 125 auch nicht rot markiert werden.
Gibt es da einen anderen Lösungsansatz?
Hier nochmal die Excel Datei mit dem Ergebnis der VBA Lösung und rechts daneben, wie es _
letztlich aussehen sollte.
Die Datei https://www.herber.de/bbs/user/108116.xlsm wurde aus Datenschutzgründen gelöscht
Sub MHz()
Dim Ws As Worksheet
Dim Daten As Range
Dim c As Range
Dim dCol As New Collection
Dim i&, j&, k&
Dim A()
Set Ws = ActiveSheet
With Ws
Set Daten = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
For Each c In Daten.SpecialCells(xlCellTypeConstants)
dCol.Add c
Next c
End With
ReDim A(0 To dCol.Count - 1)
For i = 1 To dCol.Count
A(i - 1) = dCol(i)
Next i
For j = LBound(A()) To UBound(A())
A(j) = Replace(A(j), ".", "")
A(j) = Replace(A(j), " MHz", "")
A(j) = CLng(A(j))
Next j
Call QuickSort(A(), LBound(A()), UBound(A()))
For k = LBound(A()) To UBound(A())
Ws.Cells(k + 1, 3).Value = A(k)
Next k
With Ws
For Each c In .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
If (c.Value / c.Offset(-1, 0).Value) * 100 High Then Exit Sub
vPartition = ArrayToSort((Low + High) \ 2)
i = Low: j = High
Do
Do While ArrayToSort(i) vPartition
j = j - 1
Loop
If i j
If (j - Low)