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
我使用了来自互联网的代码并为自己定制了它,当我 运行 这个确实做了我想要的事情时,它需要很长时间而且我的页面似乎跳了很多运行宁。 它 运行 通过 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