VBA:代码使我的页面在 运行 时跳转

VBA: code makes my page jump when running

我使用了来自互联网的代码并为自己定制了它,当我 运行 这个确实做了我想要的事情时,它需要很长时间而且我的页面似乎跳了很多运行宁。 它 运行 通过 2000 多行来查找数据。

任何帮助改进它并阻止它跳跃的东西都会很棒

Option Explicit
Sub Stock_Update()

Dim datasheet As Worksheet
Dim reportsheet As Worksheet
Dim Month As String
Dim frow As Long
Dim i As Integer

Set datasheet = Sheet10
Set reportsheet = Sheet9
Month = reportsheet.Range("c3").Value

reportsheet.Range("A7:l200").ClearContents

datasheet.Select
frow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 7 To frow
If Cells(i, 1) = Month Then
Range(Cells(i, 2), Cells(i, 12)).Copy
reportsheet.Select

Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

datasheet.Select

End If


Next i

reportsheet.Select

Range("A6").Select

End Sub

您的屏幕闪烁的原因是两张纸之间不断使用 select。通常,您可以使用 application.screenuptdating = false.

来避免这种情况

但最后你应该完全避免 selecting - 请阅读 How to avoid select

如果您只需要复制值,则不需要 copy/paste 操作。这也会提高性能。

我更新了您的代码 - 两种情况都可能(仅复制值或 - 像您一样 - 也复制公式和数字格式 - 只需相应地切换注释

Option Explicit

Private Const MonthRange As String = "C3"
Private Const rowStartReport As Long = 7

Public Sub createMonthlyReport()

ApplicationScreenUpdating = False

Dim wsData As Worksheet
Dim wsReport As Worksheet

Set wsData = Sheet10   'you can set the (code)name in the VBA-Editor - then you wouldn't need this
Set wsReport = Sheet9

Dim Month As String

With wsReport
    Month = wsReport.Range(MonthRange).Value
    wsReport.Cells(rowStartReport, 1).CurrentRegion.ClearContents
End With
    

Dim iRowData As Long, iRowReport As Long

Dim r As Range, rgToCopy As Range, cTarget As Range

For Each r In wsData.UsedRange.Rows
    If r.Cells(1, 1) = Month Then
        Set rgToCopy = r.Cells(, 2).Resize(, 11)    'adjust this to your needs
        Set cTarget = wsReport.Cells(rowStartReport + iRowReport, 1)
        
        'change this to your needs
        'copyValues rgToCopy, cTarget     'this is faster
        copyValuesAndFormats rgToCopy, cTarget   'this copies formulas as well
        
        iRowReport = iRowReport + 1
        
    End If
Next

wsReport.Select

wsReport.Range("A6").Select
Application.ScreenUpdating = True

End Sub

'Two Generic routines to copy values etc.

Private Sub copyValues(rgSource As Range, cTarget As Range)
'this copies values only
With rgSource
    cTarget.Resize(.Rows.Count, .Columns.Count).Value = rgSource.Value
End With
End Sub

Private Sub copyValuesAndFormats(rgSource As Range, cTarget As Range)
'this copies values, formulas and numberformats
rgSource.Copy
cTarget.PasteSpecial xlPasteFormulasAndNumberFormats
End Sub