Excel VBA运行时错误：对象“内部”的方法“颜色”失败

我正在使用在上一个问题中帮助过的代码：（ VBA Excel查找并replace ，而不是replace已经replace的项目 ）

我有以下代码，我用来replace列中的项目：Sub Replace_Once（）Application.ScreenUpdating = False

LastRow = Range("A" & Rows.Count).End(xlUp).Row Range("A1:A" & LastRow).Interior.ColorIndex = xlNone For Each Cel In Range("B1:B" & LastRow) For Each C In Range("A1:A" & LastRow) If C.Value = Cel.Value And C.Interior.Color <> RGB(200, 200, 200) Then C.Interior.Color = RGB(200, 200, 200) C.Value = Cel.Offset(0, 1).Value End If Next Next 

哪些工作正常的小文件，但是当列A接近3800的长度和B和C大约280 Excel的崩溃，我得到以下错误：

 Run-time error '-2147417848 (800810108)': Method 'Color' of object "Interior' failed 

任何想法，为什么这可能会发生？

编辑：只是为了澄清错误似乎发生在行中

  If C.Value = Cel.Value And C.Interior.Color = RGB(200, 200, 200) Then 

编辑：我附上一个示例Excel文件，显示此错误： https : //docs.google.com/file/d/0B9oTHNsTGt_gbUVYaHM4ZHFETW8/edit?usp=sharing

Answer 1

我没有为你的代码做一些优化。

1. 声明variables/对象
2. 减less你的循环时间。 此前您的代码正在循环201924100次（ 201924100 Col A行X 14210 Col B行 ）。 你不必这样做，因为B236是空的。 现在循环只运行3339350次。 （ 14210列A行235列B行 ）
3. 整个代码在1 Min 53 Seconds 。 请参阅post末尾的“ Output in Immediate window 。

尝试这个。 这对我有效。 在Excel 2013中进行testing。

 Sub Replace() Dim ws As Worksheet Dim A_LRow As Long, B_LRow As Long Dim i As Long, j As Long Application.ScreenUpdating = False Debug.Print "process started at " & Now Set ws = ThisWorkbook.Sheets("Sheet1") With ws '~~> Get Col A Last Row A_LRow = .Range("A" & .Rows.Count).End(xlUp).Row '~~> Get Col B Last Row B_LRow = .Range("B" & .Rows.Count).End(xlUp).Row .Range("A1:A" & A_LRow).Interior.ColorIndex = xlNone For i = 2 To B_LRow For j = 2 To A_LRow If .Range("A" & j).Value = .Range("B" & i).Value And _ .Range("A" & j).Interior.Color <> RGB(200, 200, 200) Then .Range("A" & j).Interior.Color = RGB(200, 200, 200) .Range("A" & j).Value = .Range("B" & i).Offset(0, 1).Value DoEvents End If Next j Next i End With Application.ScreenUpdating = True Debug.Print "process ended at " & Now End Sub 

输出在立即窗口

 process started at 10/18/2013 6:29:55 AM process ended at 10/18/2013 6:31:48 AM