If-Then Schleife Vereinfachung

Sub Auswertung ()
'Variablen deklarieren
Dim i As Long, f As Long, s As Long, Q As Long, LR As Long, LRR As Long, m As Long
Dim TB1, TB2
'Variablen definieren
Set TB1 = Sheets("Tabelle1"): Set TB2 = Sheets("Tabelle2")
LR = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
LRR = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row
'Rohdaten in Sachbereiche einteilen und in TB2 eintragen
m = 3
f = 0
With TB1 'Freigabe mit Auflage
For i = 2 To LR
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i,   _
_
_
_
_
_
7).Value = "Freigabe mit Auflage" Then 'Beanstandungsnummer entspricht Datum
f = f + 1
End If
If .Cells(i, 3).Value  "" Then
.Cells(i, 7) = "Bereich" & m
If m > 3 Then TB2.Cells(m, 3) = f
f = 0
m = m + 1
TB2.Cells(m, 1) = .Cells(i, 3)
End if
next i
TB2.Cells(m, 3) = f
end with
'Q-Info
m = 3
Q = 0
With TB1
For i = 2 To LR
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i,   _
_
_
_
_
_
7).Value = "Q-Abweichungsinfo" Then
Q = Q + 1
End If
If .Cells(i, 3).Value  "" Then
.Cells(i, 7) = "Bereich" & m
If m > 3 Then TB2.Cells(m, 7) = Q
Q = 0
m = m + 1
TB2.Cells(m, 1) = .Cells(i, 3)
End If
Next i
TB2.Cells(m, 7) = Q
End With
'Sonderfreigabe
m = 3
s = 0
With TB1
For i = 2 To LR
If .Cells(i, 9).Value = "Endkontrolle" And .Cells(i, 6).Value > 8460 And .Cells(i,   _
_
_
_
_
_
7).Value = "Sonderfreigabe" Then
s = s + 1
End If
If .Cells(i, 3).Value  "" Then
.Cells(i, 7) = "Bereich" & m
If m > 3 Then TB2.Cells(m, 5) = s
s = 0
m = m + 1
TB2.Cells(m, 1) = .Cells(i, 3)
End If
Next i
TB2.Cells(m, 5) = s
End With
End Sub