mükerrer kayıtları toplarken sorun

[nostram]

iyi çalışmalar arkadaşlar aşağıdaki kod 20.000 veride çalışıyor ancak daha fazla veride çelışmıyor

Sub Mukerrerleri_Topla_ve_Temizle()

Dim col As New Collection
Dim rng As Range
Dim i As Integer
Dim iSon As Integer
Dim x As Integer

iSon = Cells(65536, 1).End(xlUp).Row

On Error Resume Next

Application.Calculation = xlCalculationManual
' İ= KAÇINCI SATIRDAN İTİBAREN TOPLAMAYA BAŞLASIN
For i = 4 To iSon

col.Add CStr(Cells(i, 1)), CStr(Cells(i, 1))

If Err <> 0 Then
x = x + 1

If x = 1 Then
Set rng = Rows(i)
Else
Set rng = Application.Union(rng, Rows(i))
End If

Err = 0
'BİRLEŞTİRİLECEK HÜCRELERİ AŞAĞIYA YAZ
Else
Cells(i, "B") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("B2:B" & iSon))
Cells(i, "K") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("K2:K" & iSon))
Cells(i, "L") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("L2:L" & iSon))
Cells(i, "M") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("M2:M" & iSon))
Cells(i, "N") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("N2:N" & iSon))
Cells(i, "O") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("O2:O" & iSon))
Cells(i, "P") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("P2" & iSon))

Cells(i, "Q") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("Q2:Q" & iSon))
End If
Next

On Error GoTo 0

If Not rng Is Nothing Then
rng.Delete
End If

Application.Calculation = xlCalculationAutomatic

Set rng = Nothing

End Sub

 

[Korhan Ayhan]

Merhaba,

Değişken tanımlamaları INTEGER olarak yapılmış. Siz LONG olarak düzeltip deneyin.

 

[nostram]

çok teşekkür ederim işimi çözdü