PDA

Vollständige Version anzeigen : Eigene Präferenzliste für größer/kleiner Vergleich


murzel
30.06.2015, 11:27
Hallo miteinander,

ich möchte eine benutzerdefinierte Präferenzliste (X < M6 < M4 < M2 < M1 < B) für einen größer/kleiner Vergleich verwenden, bin damit als VBA Anfänger aber überfordert.

Ich suche mit meinem Code unten zu jeder Zelle im definierten Bereich (Tabelle1) zwei zugehörige Werte in Tabelle 4 mit einem Sverweis. Die beiden Sverweise geben je einen der folgenden Werte aus ["X"; "M6"; "M4"; "M2"; "M1"; "B"]. Mit meinem Code möchte ich eine bedingte Formatierung ausführen, je nachdem wie der Vergleich der beiden Sverweise ausfällt.

Mein Problem ist, dass VBA natürlich nicht weiß ob der Wert "B" größer ist als der Wert "M2" etc. - meine Frage: wie bekomme ich diese Rangfolge definiert, dass der Code weiß wie er mit den Buchstaben verfahren muss?

Mein Code funktioniert, jedoch soll für den Fall, dass beide Sverweise den gleichen Wert ausgeben NICHTS passieren - durch die true/false Abfrage kann ich diese 3. Option aber nicht differenzieren.
Sub M1_M6()
Dim RaBereich As Range ' Variable für Bereich
Dim Razelle As Range ' Variable für Zelle
Set RaBereich = Range("C7:DG94") ' Bereich der Wirksamkeit
Dim rng As Range
Dim X(0) As Byte
Dim M6(2) As Byte
Dim M4(3) As Byte
Dim M2(4) As Byte
Dim M1(5) As Byte
Dim B(7) As Byte
Set rng = Tabelle4.Range(Tabelle4.Cells(1, 1), Tabelle4.Cells(Tabelle4.Rows.Count, 21).End(xlUp))
For Each Razelle In RaBereich
On Error Resume Next
Select Case WorksheetFunction.VLookup(Razelle, rng, 20, False) < WorksheetFunction.VLookup(Razelle, rng, 21, False)
Case True: Razelle.Interior.Color = RGB(192, 0, 0) ' wenn kleiner dann Füllfarbe Dunkelrot
Case False: Razelle.Interior.Color = RGB(197, 217, 241) ' wenn größer Füllfarbe Hellblau
End Select
Next Razelle
Set RaBereich = Nothing
End Sub


Mein Lösungsansatz: Den Testausdruck von Select Case als Differenz berechnen und entsprechende Werte angeben (hier nur als Beispiel "-2" und "2").
Select Case WorksheetFunction.VLookup(Razelle, rng, 20, False) - WorksheetFunction.VLookup(Razelle, rng, 21, False)
Case "-2": Razelle.Interior.Color = RGB(192, 0, 0) ' wenn kleiner dann Füllfarbe Dunkelrot
Case "2": Razelle.Interior.Color = RGB(197, 217, 241) ' wenn größer Füllfarbe Hellblau
End Select

Problem hier ist aber wohl, dass die Ausdrücke ("M1" etc.) nicht korrekt als Zahlen definiert sind. Beim Debugging wird nichts angezeigt, aber der Code streikt dennoch. Weiß jemand Abhilfe?

Besten Dank für Eure Unterstützung!!

jack_D
30.06.2015, 12:27
Mal ein Gedankenansatz für deine Benutzerdefinierte Präferenzliste

So hast du eine "String"-Reihenfolge (im Array) einem numerischen Wert zugeordnet...

Sub index_array()

testarray = Array("X", "B", "W")

For i = 0 To UBound(testarray)
MsgBox "Postition " & i + 1 & " - Wert " & testarray(i)
Next i

End Sub


Grüße

EarlFred
30.06.2015, 13:10
Hallo!!,

ungetestet:
Select Case True
Case WorksheetFunction.VLookup(Razelle, rng, 20, False) < WorksheetFunction.VLookup(Razelle, rng, 21, False)
Razelle.Interior.Color = RGB(192, 0, 0) ' wenn kleiner dann Füllfarbe Dunkelrot
Case WorksheetFunction.VLookup(Razelle, rng, 20, False) > WorksheetFunction.VLookup(Razelle, rng, 21, False)
Razelle.Interior.Color = RGB(197, 217, 241) ' wenn größer Füllfarbe Hellblau
'Case Else
'mach nix
End Select

Grüße
EarlFred

murzel
30.06.2015, 14:43
Danke für die Antworten!

@EarlFred: Mit deiner Variante macht er das was er soll für den Bereich (Tabelle1) für den Daten im Referenzblatt (Tabelle 4, Sverweis) vorhanden sind. Für den restlichen definierten Bereich (Tabelle1), für den keine Daten im Referenzblatt (Tabelle 4, Sverweis) vorhanden sind, wählt er leider komplett die rote Formatierung, also den oberen case. Das sollte egtl nicht möglich sein, da der Sverweis in diesem Fall keinen Wert mehr ausgeben dürfte. Hast du eine Idee woran das liegen könnte?


@jack_D: Wenn ich das richtig verstehe, dann kann ich mit der Definition eines Arrays bei Abfrage der Rangfolge-Ziffer (beginnend bei 0) die zugehörige "Codierung" ausgeben lassen. Funktioniert das auch andersherum, also dass ich bei Abfrage der Codierung die Rangfolge-Ziffer im Array ausgegeben bekomme?

EarlFred
30.06.2015, 14:52
Hallo,

Hast du eine Idee woran das liegen könnte?
Nein, da ich weder Deine Mappe noch Deinen Code kenne.

Grüße
EarlFred

jack_D
30.06.2015, 15:12
Moin,

also ich bin mir nicht ganz sicher ob ich die Frage verstehe,
aber wenn du sowas meinst, wie "Positionsbestiummung"
Könnte das die Frage beantworten

Sub index_array()

testarray = Array("X", "B", "W", "F")
testwert = "F"

For i = 0 To UBound(testarray)
If testarray(i) = testwert Then
MsgBox "Die Postition von Testwert " & testwert & " ist " & i
End If
Next i

End Sub

Wenn du allerdings rechnen möchtest würde man es so lösen können
Sub rechnen_array()
testarray = Array("X", "B", "W", "F")

testwert1 = "F"
testwert2 = "W"

pos1 = Application.Match(testwert1, testarray, False)
pos2 = Application.Match(testwert2, testarray, False)

If Not IsError(pos1) And Not IsError(pos2) Then
MsgBox pos1 - pos2

End If

End Sub


Grüße

murzel
30.06.2015, 16:22
Ich habe mal eine Beispieldatei gebastelt, da das Original schon überladen ist. Datei ist angehängt.

@EarlFred: Das Problem das ich bei deinem Lösungsvorschlag habe tritt auf, wenn du das Makro (M1M6) ausführst während Tabellenblatt4 aktiv ist! Wenn Tabelle1 aktiv ist wird es ausschließlich rot. Diese Unterscheidung mit dem aktiven Blatt (im Original nicht vorhanden) habe ich jetzt auf die Schnelle nicht gelöst bekommen - wie gesagt: absoluter Anfänger...

@Jack_D: Dein zweiter Ansatz sieht für mich relativ vielversprechend aus, ich kann ihn aber noch nicht richtig auf meinen Fall ummünzen. Könnte man in deinem Testbeispiel den testwert1 = "F" auch als Formel schreiben? Ich habe es wie folgt probiert aber es funktioniert leider nicht.

testwert1 = "=WorksheetFunction.VLookup(Razelle, rng, 20, False)"


Vielen Dank für Eure Unterstützung!

jack_D
30.06.2015, 18:12
Moin,
Ja kann man.
Aber, wenn du eine ws.function aufrufst, darfst du die nicht zum String machen.
(Du trägst sie ja nicht in eine Zelle ein)
Genau müsstest du, wenn du den sverweis nehmen willst,
Testwert=worksheetfunction..... Schreiben.
Sonst ist dein testwert die Zeichenfolge zwischen " und "
Das funktioniert dann natürlich nicht.

Grüße

murzel
01.07.2015, 09:43
@jack_d: Das produziert mir leider den Laufzeitfehler 5 "ungültiger Prozeduraufruf oder Argument" :(
Fehlt da womöglich eine Deklaration für die Variablen "act" und "opt"?

Sub M1_M6()
Dim RaBereich As Range ' Variable für Wirkungsbereich
Dim Razelle As Range ' Variable für Zelle
Set RaBereich = Range("C7:DG94") ' Bereich der Wirksamkeit
Dim rng As Range ' Variable für Suchbereich
PrList = Array("X", "dummy1", "M6", "M4", "M2", "M1", "dummy2", "B")
Set rng = Tabelle4.Range(Tabelle4.Cells(1, 1), Tabelle4.Cells(Tabelle4.Rows.Count, 21).End(xlUp)) 'Suchbereich bis letzte befüllte Zeile begrenzt
act = WorksheetFunction.VLookup(Razelle, rng, 20, False) 'Testwert aktueller Wert
opt = WorksheetFunction.VLookup(Razelle, rng, 21, False) 'Testwert optimaler Wert
PosAct = Application.Match(act, PrList, False) 'aktueller Wert numerisch
PosOpt = Application.Match(opt, PrList, False) 'optimaler Wert numerisch
For Each Razelle In RaBereich
On Error Resume Next
Select Case PosAct - PosOpt
Case "-2": Razelle.Interior.Color = RGB(192, 0, 0) ' wenn kleiner dann Füllfarbe Dunkelrot
Case "2": Razelle.Interior.Color = RGB(197, 217, 241) ' wenn größer Füllfarbe Hellblau
End Select
Next Razelle
Set RaBereich = Nothing
End Sub

murzel
01.07.2015, 17:20
Habe eine Lösung! Zwar nur für meine spezifischen Zwecke und nicht für das Problem allgemein, aber imemrhin eine Lösung.

Habe den Sverweis auf eine neue Hilfsspalte gemacht, in der ich "ist größer" bzw. "ist kleiner" stehen habe. So läuft die Formatierung einwandfrei. Problem war nur die Ausgabe der Hilfsspalte. Hier bin ich aber darauf gekommen, dass die Operatoren "<" und ">" auch die natürliche Buchstabenrangfolge des Alphabets respektieren (A < B < C < D ...). Das gilt ebenso für zusammengesetzte alphanumerische Werte (A1 < A2 < A3 < A4 ...). Erfolgreich war ich dann mit einer "select case true" Abfrage.

In meinem Fall wollte es der Zufall so, dass die (vordefinierten und unverändelrichen) Variablen tatsächliche eine saubere "natürliche" Rangfolge gebildet haben (B < M1 < M2 < M4 < M6 < X).

Wäre natürlich trotzdem interessant gewesen, wie man mit VBA eine x-beliebige Rangfolge vorgeben kann.

jack_D
01.07.2015, 21:10
Moin Moin,


Sorry war heut Absent. Ich schau es mir morgen an. Da bin ich wieder am PC.

Was ist es denn für ein lfz. Bzw wo tritt er auf?
Was sagen die Variablen zu diesem Zeitpunkt?

Grüße

jack_D
02.07.2015, 09:08
Moin, Moin,

also in deinem Code passt so einiges gar nicht.

1. wenn du eine Tabelle ansprechen möchtest, machst du das günstigerweise über Worksheets.("NAme")
2. Macht es sinn wenn man viel innerhalb eines WS macht das ganze mit With "Auszuklammern"
3. suchst du mit deiner Vlookup einen Wert (razelle) den es zu dem Zeitpunkt noch nicht gibt

Ich würd es gern umbauen, aber ich hab dein gesamtanliegen noch nicht wirklich verstanden.
Daher bitte gern noch eine Erklärung.

Grüße

murzel
02.07.2015, 19:47
Servus,

besten Dank für deine Unterstützung! Das Problem habe ich wie gesagt schon gelöst. Punkt 1 ist absolut einleuchtend, für Punkt 2 fehlen mir die Grundlagen und Punkt 3 habe ich nicht verstanden (sowohl Spalte 20 als auch 21 bestehen bereits mit Werten).

Zum Verständnis: in TB1 ist ein "Schachbrett", dessen Felder einen eindeutigen Code enthalten und die ich mit der bedingten Formatierung färben möchte. Bedingung sind die Spalten 20 und 21 in TB2 in denen der "Buchstabensalat" steht. Spalte 1 in TB2 enthält die Codierungen des Schachbretts, demenstprechend ist auch der Sverweis aufgebaut. Ist Spalte 21 größer als 20 dann färbe rot, andersherum färbe blau.


Spalte....[1]............. [20]....[21]
............1234........... M1.....M4-----> kleiner: färbe zugehörige Zelle im Schachbrett blau
............5678........... M2.....B-------> größer: färbe rot
............9012............M6.....M6-----> gleich: tue nichts

Kernproblem war: Wie bringe ich VBA dazu zu begreifen, was ich subjektiv als größer bzw. kleiner definiert habe?

Muller
02.07.2015, 21:23
Hallo,

da fallen mir so aus dem Stand 3 Möglichkeiten ein:
Benutzerdef. Datentypen/Array(2-dim)
Collection/Dictionary
Variablenname als String

Gruß, Muller