2

この前の質問で助けられたコードを使用しています: ( VBA Excel は既に置き換えられた項目を置き換えずに検索して置き換えます)

列内の項目を置き換えるために使用する次のコードがあります: 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 がクラッシュし、次のエラーが発生します。

実行時エラー '-2147417848 (800810108)':

オブジェクト「インテリア」のメソッド「カラー」が失敗しました

なぜこれが起こっているのでしょうか？

編集：エラーを明確にするために、行で発生しているようです

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

1 に答える 1

2

私はあなたのコードにほとんど最適化を行いませんでした。

  1. 変数/オブジェクトを宣言しました
  2. ループ時間を短縮しました。以前のコードはループ201924100時間 ( 14210 Col A Rows X 14210 Col B Rows ) でした。B236以降は空なので、それを行う必要はありませんでした。これで、ループは 13339350回だけ実行されます。( 14210 列 A 行 X 235 列 B 行)
  3. コード全体は1 Min 53 Seconds. Output in Immediate window投稿の最後を参照してください。

これを試して。これは私にとってはうまくいきました。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

イミディエイト ウィンドウに出力

process started at 10/18/2013 6:29:55 AM
process ended at 10/18/2013 6:31:48 AM
于 2013-10-18T01:22:44.907 に答える