Hallo liebes Forum,
ich habe eine Liste in welcher verschiedene Daten stehen. Die Liste ist beigefügt und hilft hoffentlich.
Ich habe Daten welche eingetragen werden in den Spalten: I,K,M,O,Q,S,V,W,X,Y,Z und AA.
Ich habe Vorgegebene Daten in den Spalten: H,J,L,N,P,R.
Ich habe einen Toleranzwert welcher sich in C87 befindet. (Aktuell 6)
In VBA habe ich nun folgendes probiert (Achtung könnte kompliziert klingen):
Alle Werte aus I,K,M,O,Q,S,V,W,X,Y,Z und AA sollen mit den Werten aus H,J,L,N,P,R verglichen werden. Das soll wie folgt ablaufen.
In I88 habe ich den Wert 1. Es soll nun geprüft werden ob der Wert von I88 sich im Bereich von H88 - 6 bis H88 + 6 befindet.
H88 ist aktuell 26,8 also wäre der Bereich zwischen 20,8 und 32,8. (Erste Prüfung mit Spalte H)
J88 ist aktuell 52,8 also wäre der Bereich zwischen 46,8 und 58,8. (Zweite Prüfung mit Spalte J)
Diese Prüfungen gehen dann bis H,J,L,N,P,R abgearbeitet sind. sollte sich also I88 in keinem der Bereiche befinden wird es Grün markiert. Sobald es sich in einem dieser Bereiche befindet kann direkt mit der nächsten Prüfung begonnen werden. Das ganze geht mit dem Wert in K88 genauso weiter.
Ich hoffe es ist verständlich was ich erreichen möchte eine Liste hängt an mit dem Code logischerweise. Die Zeilen gehen von 88 bis 129. Ich bin für jede Hilfe dankbar.
Sub ÜberprüfenUndEinfärben()
Dim ws As Worksheet
Dim i As Long, j As Long
Dim Toleranz As Double ' Variable für die Toleranz aus Zelle C87
Dim zuPrüfendeSpalten As Variant
Dim Spalte As Variant
' Arbeitsblatt festlegen
Set ws = ThisWorkbook.Sheets("Daten_Sort_Front")
' Toleranz aus Zelle C87 lesen
Toleranz = CDbl(ws.Range("C87").Value)
' Array mit den zu prüfenden Spalten definieren
zuPrüfendeSpalten = Array("I", "K", "M", "O", "Q", "S", "V", "W", "X", "Y", "Z", "AA")
' Schleife über die Zeilen 88 bis 129
For i = 88 To 129
' Schleife über die zu prüfenden Spalten
For Each Spalte In zuPrüfendeSpalten
' Wert in der aktuellen Zelle
Dim Wert As Double
If IsNumeric(ws.Cells(i, Spalte).Value) Then
Wert = CDbl(ws.Cells(i, Spalte).Value)
Else
Wert = 0 ' Wenn der Wert nicht numerisch ist, wird er als 0 behandelt
End If
Dim k As Long
Dim untereGrenze As Double
Dim obereGrenze As Double
Dim inBereich As Boolean
inBereich = False
For k = -1 To 1 Step 2
Dim benachbarteSpalte As Variant
benachbarteSpalte = ws.Cells(i, Spalte).Offset(0, k * 2).Value
If IsNumeric(benachbarteSpalte) Then
untereGrenze = CDbl(benachbarteSpalte) - Toleranz
obereGrenze = CDbl(benachbarteSpalte) + Toleranz
If Wert >= untereGrenze And Wert <= obereGrenze Then
inBereich = True
Exit For
End If
End If
Next k
If inBereich Then
ws.Cells(i, Spalte).Interior.Color = RGB(255, 165, 0) ' Orange
Else
ws.Cells(i, Spalte).Interior.Color = RGB(0, 255, 0) ' Grün
End If
Next Spalte
Next i
End Sub
https://www.herber.de/bbs/user/168981.xlsm