时间戳

首页 > 解决方案 > 在调试模式下运行的代码 - 似乎无法处理大型数据条目

excel - 在调试模式下运行的代码 - 似乎无法处理大型数据条目

问题描述

我的代码可以从具有动态标题（取决于一年中的月份，例如 Docs_tracker 八月、九月等）的工作表的某些列中提取信息到一个名为 Charger 文件的新电子表格中......

Sub TrackerInfo()
'Pull info from respective column into correct column on charge loader file

Dim wb_mth As Workbook, wb_charges As Workbook, mapFromColumn As Variant, mapToColumn As Variant
    Dim lastCell As Integer, i As Integer, nextCell As Integer

Dim tbl As ListObject
Dim wbNames As Variant, wb As Workbook, w As Workbook, El As Variant, boolFound As Boolean

'2. Dynamic workbook
wbNames = Split("January,February,March,April,May,June,July,August,September,October,November,December", ",")
  For Each w In Workbooks
    For Each El In wbNames
        If w.Name = "Docs_Tracker_" & El & " 2020.xlsm" Then
            Set wb = w: boolFound = True: Exit For
        End If
    Next
    If boolFound Then Exit For 'in order to stop iteration if a lot of workbooks are open
     Next

'3. pulls information

    Set wb_mth = w
    Set wb_charges = Workbooks("Charger_file.xls")

    mapFromColumn = Array("O", "AH", "I", "J", "K", "V", "AF", "AI")
    mapToColumn = Array("A", "B", "C", "D", "E", "J", "K", "L")

        For i = 0 To UBound(mapFromColumn)

            With wb_mth.Worksheets(1)

                lastCell = w.Sheets("owssvr").ListObjects("Table_owssvr").Range.Rows.Count
                .Range(mapFromColumn(i) & 2 & ":" & mapFromColumn(i) & lastCell).Copy

            End With

            With wb_charges.Worksheets(1)

                nextCell = .Range(mapToColumn(i) & .Rows.Count).End(xlUp).Row + 1
                .Range(mapToColumn(i) & nextCell).PasteSpecial Paste:=xlPasteValues

            End With
        Next i
End Sub

代码在处理少量条目时+在调试模式下可以完美运行，但是在处理较大的条目时会遇到困难。离开以前的帖子，我可能需要放慢代码速度。谁能给我任何想法为什么代码似乎不起作用？我是否需要在任何地方“放慢速度”（不太清楚这意味着什么！）。谢谢。

标签： excelvba

解决方案

请尝试下一个更新的代码。未经测试，没有您的数据，但它应该可以快速运行。它使用数组来避免使用剪贴板。一个单独的问题对我来说似乎有问题，分别lastCell是计算方式，引用另一张表而不是必须复制范围的表：

Sub TrackerInfo()
 Dim wb_mth As Workbook, wb_charges As Workbook, mapFromColumn, mapToColumn
 Dim lastCell As Long, i As Long, nextCell As Long, arrCopy
 Dim wbNames, w As Workbook, El, boolFound As Boolean

'2. Dynamic workbook
 wbNames = Split("January,February,March,April,May,June,July,August,September,October,November,December", ",")
 For Each w In Workbooks
     For Each El In wbNames
        If w.Name = "Docs_Tracker_" & El & " 2020.xlsm" Then
            Set wb_mth = w: boolFound = True: Exit For
        End If
     Next
     If boolFound Then Exit For 'in order to stop iteration if a lot of workbooks are open
 Next

'3. pulls information
    Set wb_charges = Workbooks("Charger_file.xls")

    mapFromColumn = Array("O", "AH", "I", "J", "K", "V", "AF", "AI")
    mapToColumn = Array("A", "B", "C", "D", "E", "J", "K", "L")

        For i = 0 To UBound(mapFromColumn)
            With wb_mth.Worksheets(1)
                lastCell = wb_mth.Sheets("owssvr").ListObjects("Table_owssvr").Range.rows.count '??? please, check here the logic of lastCell finding
                arrCopy = .Range(mapFromColumn(i) & 2 & ":" & mapFromColumn(i) & lastCell)
            End With

            With wb_charges.Worksheets(1)
                nextCell = .Range(mapToColumn(i) & .rows.count).End(xlUp).row + 1
                .Range(mapToColumn(i) & nextCell).Resize(UBound(arrCopy), UBound(arrCopy, 2)).Value = arrCopy
            End With
        Next i
End Sub

推荐阅读