Всем доброго времени суток! Обычно находил решение проблем на данном форуме, но сейчас не могу понять в чем проблема. Есть таблица примерно на 60тыс строк. Необходимо найти все дубликаты в третьем столбце и удалить строки с первыми значениями, и затем так же пробежаться по первому столбцу. В третьем столбце числовые значения, в первом - текстовые (пробежался по столбцу Cstr).
Ошибка указывает на эту строку (поиск по первому столбцу):
| Код |
|---|
Sub delete_duplicate()
Dim endrow As Long
Dim srange As Range
Dim rrange As Range
Dim id() As Long
Dim n() As Long
Application.ScreenUpdating = False
Application.Calculation = xlManual
endrow = Worksheets("spgz").Cells(Rows.Count, 1).End(xlUp).Row
ReDim id(endrow) As Long
t = Now
r = 0
For i = 1 To endrow
Set srange = Worksheets("spgz").Range(Worksheets("spgz").Cells(i + 1, 3), Worksheets("spgz").Cells(endrow, 3))
If Not srange.Find(Worksheets("spgz").Cells(i, 3), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
r = r + 1
id(r) = i
End If
Next i
If r > 1 Then
For i = r - 1 To 1 Step -1
Rows(id(i)).Delete
Next i
End If
endrow = Worksheets("spgz").Cells(Rows.Count, 1).End(xlUp).Row
ReDim n(endrow) As Long
s = 0
For i = 1 To endrow
Set rrange = Worksheets("spgz").Range(Worksheets("spgz").Cells(i + 1, 1), Worksheets("spgz").Cells(endrow, 1))
If Not rrange.Find(Worksheets("spgz").Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
s = s + 1
n(s) = i
End If
Next i
If s > 1 Then
For i = s - 1 To 1 Step -1
Rows(n(i)).Delete
Next i
End If
t = DateDiff("s", t, Now)
MsgBox (r - 1 & " èäåíòèôèêàòîðîâ è " & s - 1 & " íàèìåíîâàíèé çà " & t & " ñåêóíä")
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
|
| Код |
|---|
If Not rrange.Find(Worksheets("spgz").Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
|
