AW: Bei Übereinstimmung benachbarte Zellen vergleichen
15.10.2017 09:39:31
fkw48
Einfach und geschmacklos
Option Explicit
' ich hoffe die Spalten haben die Überschrift
Const C_SP As String = "Kriterium Soll Ist"
Sub Frage()
'Begriff1, Begriff2
TestIt "07Krit", "22Krit"
End Sub
Sub TestIt(Krit1 As Variant, Krit2 As Variant)
Dim Flag As Integer
If IsIt(Krit1) + IsIt(Krit2) Then _
Call MsgBox("Aufgabe", vbInformation)
End Sub
Function IsIt(Begriff As Variant) As Integer
Dim Zeile As Long
On Error GoTo errh
Zeile = Suche(Begriff, Spalten(C_SP, 0))
If Zeile And Cells(Zeile, Spalten(C_SP, 2)) > Cells(Zeile, Spalten(C_SP, 1)) Then _
IsIt = 1
On Error GoTo 0
errh:
End Function
Function Suche(Was As Variant, Wo As Variant) As Long
On Error GoTo fail:
Dim Rng As Range
Set Rng = Columns(Wo).Find(Was, , xlValues)
If Rng Is Nothing Then Set Rng = Columns(Wo(0)).Find(Was, , xlValues)
If Not Rng Is Nothing Then Suche = Rng.Row
On Error GoTo 0
fail:
End Function
Function Spalten(Wo As String, Teil As Variant) As Variant
Dim arrs() As String, arrN(0 To 2) As Variant
arrs = Split(Wo, " ")
Spalten = Cells.Find(arrs(Teil), , xlValues).Column
End Function