花费太多时间从一个excel表格行（匹配行）复制到另一个Excel表 - VBA [英] Taking too much time to copy from one excel sheet row (matching rows) to another excel sheet - VBA

问题描述

我正在使用此代码进行命令点击事件，将行从一个工作表中复制到另一个工作表。正在花费太多时间才能加载到工作表中。

I am using this code for command click event to copy rows from one sheet with some criteria to another sheet. It is taking too much time to get loaded into the sheet.

有没有办法加速？我是新来的VBA excel，我正在学习。

Is there a way to speed this up? I am new to VBA excel and I am learning.

Dim lngLastRow As Long
Dim lngRow As Long
Dim strValue As String
Dim lngRowOutput As Long

' getting last row of Material Master data
lngLastRow = Sheets(2).UsedRange.Rows.Count
' MsgBox lngLastRow

Application.ScreenUpdating = False

' Clear down sheet from Row 2. Row 1 is for column headers.

Sheets(6).Range("2:1048570").Clear  'MM Criticality sheet

lngRowOutput = 2 ' where are we going to write the values to in Sheet2  

For lngRow = 2 To lngLastRow
     strValue = Sheets(2).Cells(lngRow, 5).Value  ' getting value from column D

    'Checking for particular text in the transactions..
    If InStr(1, strValue, "specified in the table ", vbTextCompare) > 0 Then
         Sheets(2).Rows(lngRow).Copy
        Sheets(6).Rows(lngRowOutput).PasteSpecial
        lngRowOutput = lngRowOutput + 1
    Else
  '    MsgBox Sheets(3).Rows(lngRow).Copy
    End If

Next lngRow

Application.ScreenUpdating = True

Worksheets(6).Activate
Worksheets(6).Visible = True
Worksheets(6).Select
End sub

推荐答案

请尝试下面的简单更改。而不是复制粘贴，请具体引用这些值：

Try the simple change below. Instead of copy paste, reference the values specifically:

Dim lngLastRow As Long Dim lngRow As Long Dim strValue As String Dim lngRowOutput As Long

' getting last row of Material Master data
lngLastRow = Sheets(2).UsedRange.Rows.Count
' MsgBox lngLastRow

Application.ScreenUpdating = False

' Clear down sheet from Row 2. Row 1 is for column headers.


Sheets(6).Range("2:1048570").Clear  'MM Criticality sheet

lngRowOutput = 2 ' where are we going to write the values to in Sheet2  


For lngRow = 2 To lngLastRow
     strValue = Sheets(2).Cells(lngRow, 5).Value  ' getting value from column D

    'Checking for particular text in the transactions..
    If InStr(1, strValue, "specified in the table ", vbTextCompare) > 0 Then
        Sheets(6).Rows(lngRowOutput) = Sheets(2).Rows(lngRow).Value
        lngRowOutput = lngRowOutput + 1
    Else
  '    MsgBox Sheets(3).Rows(lngRow).Copy
    End If

Next lngRow
Application.ScreenUpdating = True

Worksheets(6).Activate 
Worksheets(6).Visible = True
Worksheets(6).Select 
End sub

这篇关于花费太多时间从一个excel表格行（匹配行）复制到另一个Excel表 - VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！