Problem mit "bedingter Formatierung"
02.10.2017 15:38:55
Sebastian
um mir meine Arbeit zu erleichtern, habe ich mir eine Mappe mit diversen Makros zusammengebastelt.
Es geht im Grunde darum:
Ich bekomme eine xls-Datei mit einer variablen Anzahl an Analysenergebnissen (Zeilen) für eine variable Anzahl an Proben (Spalten).
Zunächst werden die Daten in Blatt1 (Ergebnisse) meiner Mappe kopiert und um alle Zeilen (also analysierten Substanzen) bereinigt, in denen es für keine der Proben ein positives Ergebnis gibt (Ergebnis unter Bestimungsgrenze => zb. " Außerdem erhalten die Substanzen per SVERWEIS deutsche Bezeichnungen, die sich in Blatt2 (Daten) befinden. Daneben sind in Blatt2 u.a. diverse Prüfwerte für die einzelnen Substanzen hinterlegt, die über eine userform ausgewählt werden können und dann per sverweis rechts neben der letzten Probe eingefügt werden.
Soweit so gut...
Ich will jetzt, dass Ergebnisse, die einen Prüfwert überschreiten mit einer entsprechenden Zellfärbung versehen werden. Was sich eigentlich nach einer einfachen Abfrage a la bedingte Formatierung anhört, bringt mich seit einigen Wochen zur Verzweiflung.
Hier mal als Beispiel eine Variante für den Prüfwert AGOEF, der sich in Spalte mAGOEF befindet, die zumindest fast funktioniert:
Sub mAGÖF()
Dim i As Integer
Dim lastrow1, lastrow2, lastcol1, lastcol2 As Long
Dim Mappe As Workbook
Dim Ergebnisse As Worksheet
Dim Daten As Worksheet
Dim rngDaten As Range
Dim WsF As WorksheetFunction
Dim ename As String
Dim lr As Long
Dim x As Object
Dim mAGOEF As Integer
Set Mappe = ThisWorkbook
Set Daten = Mappe.Worksheets("Daten")
Set Ergebnisse = Mappe.Worksheets("Ergebnisse")
Set WsF = Application.WorksheetFunction
lastrow1 = IIf(IsEmpty(Ergebnisse.Range("E300")), Ergebnisse.Range("E300").End(xlUp).Row, 300)
lastcol1 = IIf(IsEmpty(Ergebnisse.Range("VI3")), Ergebnisse.Range("IV3").End(xlToLeft).Column, _
50)
lastrow2 = IIf(IsEmpty(Daten.Range("A300")), Daten.Range("A300").End(xlUp).Row, 300)
lastcol2 = IIf(IsEmpty(Daten.Range("VI3")), Daten.Range("IV3").End(xlToLeft).Column, 50)
Set rngDaten = Daten.Range("A1:X" & lastrow2) 'nach O in Daten Refwerte mit Sonderzeichen
mAGOEF = lastcol1 + 1
Ergebnisse.Select
Columns(mAGOEF).Select
Selection.Insert Shift:=xlToRight
sNr = Sheets(3).Range("A1").Value
With WsF
For i = 1 To lastrow1
ename = Ergebnisse.Cells(i, 1).Value
If ename = "" Or ename = "0" And i = Ergebnisse.Cells(i, mAGOEF).Value Then
x.Interior.Pattern = xlPatternDown 'xlPatternVertical ' xlPatternChecker ''' _
xlPatternSemiGray75'xlPatternDown'xlPatternCrissCross'xlPatternGray50
x.Interior.PatternColor = RGB(255, 255, 116)
End If
Next x
weiter:
Next i
Columns(mAGOEF).Hidden = True
End Sub