Option Explicit
Function ZellenFärben()
Dim rng As Range, AV, R&, C&, SerienNummer, SachNummer
SerienNummer = 324223
SachNummer = 2052355
If Not FindSN(SachNummer) Then
MsgBox "Sachnummer konnte nicht gefunden werden."
Exit Function
End If
Set rng = ActiveSheet.Range("A1:H100")
AV = rng.Value
For R = 1 To UBound(AV)
For C = 1 To UBound(AV, 2)
If AV(R, C) = SerienNummer Then
Select Case AV(R, C + 1)
Case "FAIL"
rng(R, C).Interior.ColorIndex = 3
Case "PASS"
rng(R, C).Interior.ColorIndex = 4
End Select
End If
Next
Next
End Function
Private Function FindSN(SachNummer) As Boolean
Dim List$(), FileName$, I&
If Not OpenTxt(List, ThisWorkbook.Path & "\Test.txt") Then Exit Function
For I = 0 To UBound(List)
If InStr(1, List(I), SachNummer) Then
FindSN = True
Exit Function
End If
Next
End Function
Private Function OpenTxt(FileData$(), ByVal FileName$) As Boolean
On Error GoTo BadData
Dim FileNum%, Fields$, I&
FileNum = FreeFile
ReDim FileData(0 To 0)
Open FileName For Input As FileNum
Do While Not EOF(FileNum)
Line Input #FileNum, Fields
ReDim Preserve FileData(0 To I)
FileData(I) = Fields
I = I + 1
Loop
Close
FileName = 0
Fields = 0
I = 0
OpenTxt = True
Exit Function
BadData:
End Function