Fehler bei grossen Zahlen

Sub tOriginal()
Dim lzeileS As Long, lZeileE As Long
Dim rng As Range, ranrngSuch As Range, rngErg As Range
Dim myarr
Dim intZ As Integer
With Sheets("Datenbank")
lzeileS = .Cells(.Rows.Count, 1).End(xlUp)
Set rngSuch = Range("A3:A" & lzeileS)
End With
With Sheets("Abrechnung")
lZeileE = .Cells(.Rows.Count, 1).End(xlUp)
Set rngErg = Range("A4:A" & lZeileE)
ReDim myarr(1, lZeileE)
For Each rng In .Range(rngErg.Address)
myarr(0, intZ) = rng
myarr(1, intZ) = rng.Offset(0, 15)
intZ = intZ + 1
Next
End With
With Sheets("Datenbank")
For Each rng In .Range(rngSuch.Address)
For intZ = 0 To intZ - 1
If rng = myarr(0, intZ) Then _
rng.Offset(0, 17) = rng.Offset(0, 17) - myarr(1, intZ)
Next
Next
End With
End Sub