Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 如何制作一个;复制粘贴";宏运行得更快?_Excel_Vba - Fatal编程技术网

Excel 如何制作一个;复制粘贴";宏运行得更快?

Excel 如何制作一个;复制粘贴";宏运行得更快?,excel,vba,Excel,Vba,我在Excel VBA中编写了一个宏,它基本上复制粘贴53行1440次,一行一行,以填充~70000行表中的两列。宏可以工作,但完全运行大约需要五分钟。如果我不必在大约1000个其他文件上运行它,这将是很好的。我正在寻找任何方法来加快这一进程,使它不需要5天运行 我尝试使用范围复制方法: Set range1 = {the table I'm copying} Set range2 = {the cells I want to paste into} range1.C

我在Excel VBA中编写了一个宏,它基本上复制粘贴53行1440次,一行一行,以填充~70000行表中的两列。宏可以工作,但完全运行大约需要五分钟。如果我不必在大约1000个其他文件上运行它,这将是很好的。我正在寻找任何方法来加快这一进程,使它不需要5天运行

我尝试使用范围复制方法:

    Set range1 = {the table I'm copying} 
    Set range2 = {the cells I want to paste into} 
    range1.Copy range2
但它花了同样长的时间,如果不是更长的话

这是我目前的代码:

    Windows("as_built_comp.xlsm").Activate
    Sheets(siteName).Activate
    j = Cells(Rows.Count, 1).End(xlUp).Row
    Range("C2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wb.Activate
    Range("I12").Select
    For i = 1 To 1440
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
              SkipBlanks _
        :=False, Transpose:=False
        ActiveWindow.SmallScroll Down:=56
        ActiveCell.Offset(j - 1, 0).Select
    Next i

我认为解决方案可能与在VBA中使用sql有关,但我还没有学习该语法。无论哪种方式,我们都非常感谢您的建议。谢谢你的阅读

将其全部加载到一个数组中,然后在最后输出整个数组。代码重构以避免使用activate/select

Sub tgr()

    Dim wbDest As Workbook
    Dim wbData As Workbook
    Dim wsDest As Worksheet
    Dim wsData As Worksheet
    Dim aTemp() As Variant
    Dim aData() As Variant
    Dim SiteName As String
    Dim RepeatData As Long
    Dim ixTemp As Long
    Dim ixData As Long
    Dim ixCol As Long

    SiteName = "SiteName1"
    RepeatData = 1440

    Set wbDest = ThisWorkbook
    Set wbData = Workbooks("as_built_comp.xlsm")
    Set wsDest = wbDest.Worksheets(1)
    Set wsData = wbData.Worksheets(SiteName)

    With wsData.Range("C2:D" & wsData.Cells(wsData.Rows.Count, "C").End(xlUp).Row)
        If .Row < 2 Then Exit Sub   'No data
        aTemp = .Value
        ReDim aData(1 To .Rows.Count * RepeatData, 1 To .Columns.Count)
    End With

    For ixData = 1 To UBound(aData, 1)
        ixTemp = ((ixData - 1) Mod UBound(aTemp, 1)) + 1
        For ixCol = 1 To UBound(aTemp, 2)
            aData(ixData, ixCol) = aTemp(ixTemp, ixCol)
        Next ixCol
    Next ixData

    wsDest.Range("I12").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData

End Sub
Sub-tgr()
将wbDest设置为工作簿
将wbData设置为工作簿
将wsDest设置为工作表
将wsData设置为工作表
Dim aTemp()作为变量
Dim aData()作为变量
将SiteName设置为字符串
Dim将数据重复为长
暗度和温度一样长
将数据视为长数据
像长一样暗
SiteName=“SiteName1”
RepeatData=1440
设置wbDest=ThisWorkbook
设置wbData=工作簿(“竣工公司xlsm”)
设置wsDest=wbDest.工作表(1)
设置wsData=wbData.Worksheets(SiteName)
使用wsData.Range(“C2:D”和wsData.Cells(wsData.Rows.Count,“C”).End(xlUp.Row)
如果.Row<2,则退出Sub“无数据”
aTemp=.Value
ReDim aData(1到.Rows.Count*RepeatData,1到.Columns.Count)
以
对于ixData=1到UBound(aData,1)
ixTemp=((ixData-1)Mod UBound(aTemp,1))+1
对于ixCol=1至UBound(aTemp,2)
aData(ixData,ixCol)=aTemp(ixTemp,ixCol)
下一个ixCol
下一个ixData
wsDest.Range(“I12”)。调整大小(UBound(aData,1),UBound(aData,2))。值=aData
端接头

删除所有的“.Activate`并
。选择
。这是不必要的步骤,会减慢代码的速度。使用工作表限定对象-这将消除代码关注所选内容或活动内容的需要。您也可以尝试值传输,而不是复制/粘贴。这太快了,这太完美了!!!非常感谢你的帮助,这真的很快就实现了。你是救命恩人!!