Excel 更快地复制值

Question

大家好，我带着另一个新手问题回来了。

我最近在 VBA 中为一个按钮编写了代码，该按钮将值从一张纸复制到另一张纸。我用来制作一些自定义条目的第一张工作表和目标工作表就像一个包含所有条目的数据库。起初效果很好，但数据库中的条目越多，脚本就越慢。

我想知道是否有办法加快这个过程，或者至少让我可以在按下按钮后更改工作表并执行其他一些任务。

我的代码:

• 变量ws 是包含数据和按钮的工作表。

• 变量 ws1 是数据库位置。

Private Sub CommandButton1_Click()

Dim Ticker As String, Nameofcompany As String, Industry As String, Sector As String, Price As String, MC As String, Revenue As String, Valuation As String, Confidence As String, Criteria As String, Watchlist As String, Track As String, Today As String, ExTicker As Range
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
Set ws = Sheet4
Set ws1 = Sheet3
Set ws2 = Sheet2

ws.Select
Ticker = Range("Ticker")
Set ExTicker = ws1.Range("C5:C500").Find(what:=Ticker, LookIn:=xlValues, lookat:=xlWhole)
If ExTicker Is Nothing Then
    Nameofcompany = Range("Name")
    Industry = Range("Industry")
    Sector = Range("Sector")
    Price = Range("Price")
    MC = Range("MC")
    Revenue = Range("Revenue")
    Valuation = Range("Valuation")
    Confidence = Range("Confidence")
    Criteria = Range("Criteria")
    Watchlist = Range("Watchlist")
    Track = Range("Track")
    Today = Range("O5")
    ws1.Select
    ws1.Range("C4").Select
    If ws1.Range("C4").Offset(1, 0) <> "" Then
    ws1.Range("C4").End(xlDown).Select
    End If
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Ticker
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Nameofcompany
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Industry
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Sector
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Price
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = MC
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Revenue
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Valuation
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Confidence
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Criteria
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Watchlist
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Track
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Today
    Else
    MsgBox "This company is already in the list"
End If
End Sub

Answer 1

根据注释，一种避免 Select 的方法找到最后一行从底部开始工作(更稳健)并使用循环来减少代码的大小。

Private Sub CommandButton1_Click()

Dim Ticker As String, ExTicker As Range
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet, i As Long, v As Variant

Set ws = Sheet4
Set ws1 = Sheet3
Set ws2 = Sheet2

Application.ScreenUpdating = False

ws.Select
Ticker = Range("Ticker")
Set ExTicker = ws1.Range("C5:C500").Find(what:=Ticker, LookIn:=xlValues, lookat:=xlWhole)
If ExTicker Is Nothing Then
    v = Array("Name", "Industry", "Sector") 'etc
    For i = LBound(v) To UBound(v)
        ws1.Range("C" & Rows.Count).End(xlUp)(2).Value = Range(v(i)).Value
    Next i
Else
    MsgBox "This company is already in the list"
End If

Application.ScreenUpdating = True

End Sub