Question

我拥有通常可以正常运行的代码，但是要花很多时间才能运行它-我总是需要按'Esc'键来破坏它，因为否则我可能要等一整天。当我确实按“ Esc”时，代码通常会排除应有的内容。但这很烦人，我希望它能平稳运行。

我的代码应该在一列中执行简单的Index公式，直到表格末尾（即根据前面的列匹配另一张表中的某个单词并将其作为结果返回），然后应该复制并粘贴该列中的内容使公式消失，只保留返回的值。

Option Explicit
Sub Match_CopyPaste()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim r As Long
Dim endRow As Long
Dim TargetRow As Long
Const ColumnStart As Integer = 2
Const ColumnEnd As Integer = 2

TargetRow = 4


With ThisWorkbook.Sheets("Sheet1")

                 '*********Clear what is inside********'

    .Range(.Cells(TargetRow, ColumnStart), .Cells(.Rows.Count, ColumnEnd)).ClearContents

    .Range("A4", .Cells(Rows.Count, "A").End(xlUp)).Offset(0, 1).FormulaR1C1 = "=IFERROR(INDEX(Array,MATCH(RC[-1],Name,0),2),"""")"

End With


'***Part where the problem is:*******
    With ThisWorkbook.Sheets("Sheet1")
           '************** Copy and paste it as values*********
     endRow = .Cells(.Rows.Count, ColumnEnd).End(xlUp).Row     
        For r = 4 To endRow

        Cells(r, ColumnEnd).Value = Cells(r, ColumnEnd).Value
        Next r

    End With



    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    End Sub

我要补充一点，这是代码的第二部分（将其复制并粘贴为值）。代码中是否有某些东西（例如顺序或结构）使得无法填充较长的列？

Answer 1

根据BigBen评论：

With ThisWorkbook.Sheets("Sheet1")
       '************** Copy and paste it as values*********
    With .Range(.Cells(4, ColumnEnd), .Cells(.Rows.Count, ColumnEnd).End(xlUp))
        .Value = .Value
    End With
End With

复制并粘贴为值

1 个答案: