Quick&Dirty lt. Muster

Option Explicit

Sub Test()
Dim Tab1 As Excel.Worksheet, Tab2 As Excel.Worksheet
Dim RngU As Range, rngRow As Range
Set Tab1 = Sheets("Tabelle1")
Set Tab2 = Sheets("Tabelle2")
'
   With Tab1
      With .Columns("B:Q")
         
         'Umfang der Suche
         Set RngU = Range(.Cells(1), .Cells(.Cells.Count).End(xlUp))
         
         'habe Überschrift
         Set RngU = RngU.Offset(1).Resize(RngU.Rows.Count - 1)
         
         'über alle Zeilen
         For Each rngRow In RngU.Rows
            
            'schreibe Ergebnis der Substraktion rechts von (in Ergebnis)
            With rngRow.Cells(rngRow.Cells.Count).Offset(, 1)
               .Value = FiltIt(Tab2, rngRow.Cells(1).Value, ">" & _
                  Replace(CStr(rngRow.Cells(rngRow.Cells.Count).Value), ",", "."))
               
               'nur wenn
               If .Value > 0 Then
                  .Value = .Value - .Offset(, -1).Value
               Else
                  .Value = ""
               End If
            End With
         
         Next rngRow
      End With
   End With

End Sub

Private Function FiltIt(Sh As Worksheet, Nme As Variant, Wrt As String) As Double
Dim rngF As Range, rngV As Range
   With Sh
      If .AutoFilterMode Then .AutoFilterMode = False
      
      With .Columns("B:Q")
         Set rngF = Range(.Cells(1), .Cells(.Cells.Count).End(xlUp))
         With rngF
            On Error Resume Next
            .AutoFilter Field:=1, Criteria1:=Nme
            .AutoFilter Field:=16, Criteria1:=Wrt, Operator:=xlAnd
            Set rngV = rngF.Offset(1).Resize(rngF.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            'nimmt den erste Wert wo größer
            FiltIt = rngV.Columns(16).Cells(1).Value
            On Error GoTo 0
         End With
      End With
   End With

End Function