Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1512to1516
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Neuer Versuch - VBA-Lösung gesucht

Neuer Versuch - VBA-Lösung gesucht
14.09.2016 09:22:35
Bernd
Guten Tag zusammen.
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

Hier die VBA-Lösung:
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) 

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: vorheriger thread ist im Archiv ...
14.09.2016 11:25:36
...
Hallo Bernd,
... Deine Aussage wonach der tread nicht mehr beachtet wurde, ist sicherlich nicht zutreffend. Michael wird wohl nur keine Zeit mehr gefunden haben.
Wenn Du aber einen neuen thread aufmachst (weil der vorherige wie hier deaktiviert im Archiv liegt) solltest Du aber immer den Link auf einen solchen mit angegeben.
Ich mach das diesmal für Dich: https://www.herber.de/forum/archiv/1512to1516/t1513337.htm
und stelle diesen neuen thread auch gleich wieder offen.
Gruß Werner
.. , - ...
Anzeige
AW: vorheriger thread ist im Archiv ...
16.09.2016 08:49:17
Bernd
Werdet ihr bei nicht antworten meiner Threads trotzdem bezahlt? Anscheinend hat ja hier keiner Bock und wie zuvor, wurde auch dieser Post nicht beachtet.
Keine Grüße gehen raus an euch.
AW: Deine Aussagen sind völlig realitätsfern ...
16.09.2016 15:43:22
...
Hallo Bernd,
... alle Helfer hier wie auch in anderen Foren helfen Fragestellern völlig freiwillig und unbezahlt in Ihrer Freizeit. Weder Du, noch andere haben ein Recht hier und in anderen Foren eine zufriedenstellende Antwort auf gestellte Fragen bzw. weitergehende Hilfe zu erhalten. Das dies in den allermeisten Fällen hier wie auch in andern Foren trotzdem geschieht, ist für die Fragesteller einerseits ein Glück anderseits führt das offensichtlich zu solch einer Fehleinschätzung, wie Du sie getroffen hast.
Wenn Du oder ein/e Andere/r mal nicht die Hilfe erhält die angestrebt wurde, dann kann das verschiedene Ursachen haben, auf die ich hier nicht weiter eingehe. Auf keinen Fall gibt es der- bzw. demjenigen dann das Recht, derartig abfällig zu urteilen, wie Du es hier getan hast.
Ich stell den thread bzgl. Deiner ursprünglichen Frage trotzdem nun wieder offen.
Gruß Werner
.. , - ...
Anzeige
so ist es!
17.09.2016 20:17:02
Michael
Hi,
aber weil Michael (migre) hier schon Vorarbeit geleistet hat, habe ich die paar Zeilen schnell ergänzt:
Sub MHzMneu()
Dim Ws As Worksheet
Dim Daten As Range
Dim c As Range
Dim dCol As New Collection
Dim i&, j&, k&
Dim lV#  ' last Value
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 = Int(lV) Then
lV = A(k) * 1.1
Else
Ws.Cells(k + 1, 5).Interior.Color = vbYellow  ' (1)
Ws.Cells(k + 1, 10).Interior.Color = vbYellow ' (2)
End If
Next k
End Sub

und auf den Button "Neustart" gelegt.
Das Makro gibt zwei Varianten aus: als Text in Spalte E und als Zahl in Spalte J, wobei letztere mit Einheit (MHz) und Tausendertrennzeichen formatiert wurde.
Je nach Gusto kannst Du jeweils die Zeilen mit (1) oder mit (2) auskommentieren, je nach dem, was Dir lieber ist: den 1000er-"." in den Text reinzupfriemeln war mir jetzt zu viel Arbeit - zumal Du manchmal etwas batzig rüberkommst.
Ohnehin wird sich Dein sehr verehrter Arbeitgeber doch mal nen Programmierer leisten können, das ist bei DIESEM Problem günstiger als der Eimer Farbe, um den Panzer zum 35. Mal zu übermalen.
Die Datei: https://www.herber.de/bbs/user/108237.xlsm
Schöne Grüße,
Michael
Anzeige
Nur interessiert es diesen Brot, äh Bernd ...
18.09.2016 02:28:36
Luc:-?
…wohl nicht mehr, Michael;
Leute gibt's, die glauben tatsächlich, jemand bezahlt Leute fürs Antworten und verlangt dann selber keins vom Frager…
Mann-o-mann! Soll er doch auf einer Profi-Seite nachfragen, da wird er das schon merken!
Gruß, Luc :-?

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige