请教一个问题

Sub de()
'On Error Resume Next
Set d = CreateObject("scripting.dictionary")
r = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
ar = Sheets(2).Range("C2:C" & r) '表2C列为单号
For i = 1 To UBound(ar)
d(ar(i, 1)) = i
Next
arr = Sheets(1).[A1].CurrentRegion
b = UBound(arr, 2)
ReDim drr(1 To r, 1 To b)
For j = 1 To UBound(arr, 1)
If d(arr(j, 2)) > 0 Then
f = f + 1
d(arr(j, 2)) = 0 '去重复去重复去重复去重复去重复
For k = 1 To b
drr(f, k) = arr(j, k)
Next
End If
Next
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).[B:B].NumberFormatLocal = "@"
Sheets(1).[1:1].Copy Sheets(Sheets.Count).[A1]
Sheets(Sheets.Count).[A2].Resize(f, UBound(drr, 2)) = drr
Sheets(Sheets.Count).Columns.AutoFit
End Sub

代马之前跟人买的，然后那个人删了我，几个月没出过问题，这月前面10几个都运算成功，最后剩几个总是错误。

大雪无情人有情，谁帮我看看

帮顶

首先大家得先搞清楚你代码是怎么样的，然后你没有贴出源数据，且没有贴出运行错误显示的是什么错误，根本没法解决