首页 > 解决方案 > 复制并粘贴为值

问题描述

我有通常可以运行的代码,但运行它需要很长时间 - 我总是需要通过按“Esc”来打破它,因为否则我可能会等待一整天。当我按下“Esc”时,代码通常会执行它应该执行的操作。但这很烦人,我想让它顺利运行。

我的代码应该在一列中执行简单的索引公式,直到表格结束(即根据前面的列匹配另一张表中的某个单词并将其作为结果返回),然后它应该复制并粘贴其中的内容列以使公式消失并仅保留返回值。

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

我将补充一点,它是代码中断的代码的第二部分(将其复制并粘贴为值)。是代码中的某些内容,例如无法向下填充长列的顺序或结构吗?

标签: vbaexcel

解决方案


根据 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

推荐阅读