Question

执行vlookup代码后，是否有更有效的方法来复制和粘贴值？我们的想法是，在将近10,000多个单元格中执行vlookup之后，我想复制并粘贴这些值，因为它使excel文件更加稳定。

Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
Dim Z As Long

'What are the names of our worksheets?
 Set sourceSheet = Worksheets("Sheet1")
 Set outputSheet = Worksheets("Sheet2")


'Determine last row of source
 With sourceSheet
 SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet

 'Determine last row in col C
  OutputLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
 For Y = 17 To 28 'Q to AB
  For X = 2 To OutputLastRow
   If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 And    Cells(2, Y) = "Forecast" Then
 'Apply  formula
 .Cells(X, Y).Formula = _
   "=VLOOKUP($E" & X & ",'" & sourceSheet.Name & "'!$A$2:$L$" & SourceLastRow & ",Match(" & Cells(1, Y).Address & ",'" & sourceSheet.Name & "'!$A$1:$AD$1,0),0)"
   .Cells(X, Y).Select
   .Cells(X, Y).Copy
   .Cells(X, Y).PasteSpecial Paste:=xlPasteValues
End If
 Next
Next

End With
End Sub

Answer 1

With .Cells(X, Y)
    .Value = .Value
End With

Answer 2

将.Formula更改为.Value，以便VBA直接执行vlookup然后粘贴值

  .Cells(X, y).Value = _
  Evaluate("=VLOOKUP($E" & X & ",'" & sourceSheet.Name & "'!$A$2:$L$" & SourceLastRow & ",Match(" & Cells(1, y).Address & ",'" & sourceSheet.Name & "'!$A$1:$AD$1,0),0)")

执行Vlookup后的VBA复制和粘贴

2 个答案: