Excel VBA运行时错误：方法“颜色”物体“内部”失败 [英] Excel VBA runtime error: method "color" of object "interior" failed

问题描述

我正在使用上一个问题帮助我的代码：（ VBA Excel查找和替换WITHOUT替换已替换的项目）

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

  LastRow = Range（A& Rows.Count）.End（xlUp）.Row 
范围（A1：A& LastRow）.Interior.ColorIndex = xlNone 
对于每个Cel In范围（B1：B& LastRow）
对于每个C范围内（A1：A& LastRow）
如果C.Value = Cel.Value和C.Interior.Color< > RGB（200,200,200）然后
 C.Interior.Color = RGB（200,200,200）
 C.Value = Cel.Offset（0，1）.Value 
结束如果
下一个
下一个
  

哪些适用于小文件，但是当列A接近3800长度，B和C约为280个Excel崩溃，我收到以下错误：

 运行时错误' -2147417848（800810108）'：
 
方法对象的颜色内部失败
  

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

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

 如果C.Value = Cel.Value和C.Interior.Color = RGB（200,200,200）然后
  / pre> 
 
 
编辑：我附有一个示例excel文件，显示此错误：
  https://docs.google.com/file/d/0B9oTHNsTGt_ gbUVYaHM4ZHFETW8 /编辑？usp =共享 
解决方案
我的代码几乎没有优化。
 
 
声明变量/对象
 
 
减少循环时间。早些时候，您的代码循环 201924100  times（ 14210 Col A Rows X 14210 Col B Rows ）。您不需要这样做，因为 B236 向前是空的。现在循环只运行 3339350 次。 （ 14210 Col A Rows X 235 Col B Rows ）
 
 
整个代码在中完成1 Min 53 Seconds 。请参阅在立即窗口中输出。
 
 
尝试此。这对我有用在Excel 2013中测试。
  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.Printprocess started at&现在
 
设置ws = ThisWorkbook.Sheets（Sheet1）
 
与ws 
'~~>获取最后一行
 A_LRow = .Range（A& .Rows.Count）.End（xlUp）.Row 
'~~>获取Col B最后一行
 B_LRow = .Range（B& .Rows.Count）.End（xlUp）.Row 
 
 .Range（A1：A& A_LRow ）.Interior.ColorIndex = xlNone 
 
对于i = 2到B_LRow 
对于j = 2到A_LRow 
如果.Range（A& j）.Value =。范围（B& i）.Value和_ 
 .Range（A& j）.Interior.Color<> RGB（200,200,200）然后
 .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 
 
 Application.ScreenUpdating = True 
 
 Debug.Print进程以&现在
 End Sub 
  
 立即窗口输出 
 进程始于10/18/2013 6:29:55 AM 
进程在10/18/2013结束6:31 ：48 AM 
  
 
I am using the code that I was helped with in this previous question: (VBA Excel find and replace WITHOUT replacing items already replaced)

I have the following code that I use to replace items in a column:
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
Which works fine for small files, but when column A approaches 3800 in length and B and C are about 280 Excel crashes and I get the following error:
Run-time error '-2147417848 (800810108)':

Method 'Color' of object "Interior' failed
Any ideas why this could be happening?

EDIT: Just to clarify the error seems to happen in the line
 If C.Value = Cel.Value And C.Interior.Color = RGB(200, 200, 200) Then
EDIT: I am attaching an example excel file which shows this error:
https://docs.google.com/file/d/0B9oTHNsTGt_gbUVYaHM4ZHFETW8/edit?usp=sharing
解决方案
I did few optimization to your code.

Declared the variables/objects
Reduced your loop time. Earlier your code was looping 201924100 times (14210 Col A Rows X 14210 Col B Rows). You didn't have to do that because B236 onwards is empty. Now the loop runs only 3339350 times. (14210 Col A Rows X 235 Col B Rows)
The entire code finished in 1 Min 53 Seconds. See Output in Immediate window at the end of the post.
Try this. This worked for me. Tested it in Excel 2013.
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
Output in Immediate window
process started at 10/18/2013 6:29:55 AM
process ended at 10/18/2013 6:31:48 AM


                        
这篇关于Excel VBA运行时错误：方法“颜色”物体“内部”失败的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！