Question

我的第一个问题。这是一种紧急情况。

我写了一个VBA程序，它接受输入的Excel文件，打开它们，转到指定的工作表并开始复制数据行，将其粘贴到一个输出文件中，该文件在程序完成后生成并保存。复制最后一行后，输入的Excel文件将关闭。我编写了该过程，以便它对当前文件夹中的所有输入文件执行此操作。关闭第一个输入文件后，打开另一个文件并重复执行该过程，直到扫描文件夹中的所有文件并将正确的行存储在输出文件中。

这就是问题所在。如果我只使用一个输入文件运行此过程，则持续时间大约为5秒。如果我使用两个输入文件执行此过程，则持续时间增加到大约50秒。三个输入文件给我大约450秒的工作时间。

我需要这个过程将行从大约50个文件复制到输出文件中。如果此持续时间以相同的速率继续增加，则最终持续时间将长于我的预期寿命。

这是VBA程序的正常行为还是我有RAM问题？

所有答案将不胜感激。马丁

编辑：这是代码的要点。我删除了重复和变量声明。

Option Explicit

Sub Procedure()

'[all declarations and definitions of fixed arrays]

Application.ScreenUpdating = False

folder_name = Application.ActiveWorkbook.Path
output_name = folder_name & "\Master_output"

Set Output_File = Application.Workbooks.Add(1)
Set Output_File = ActiveWorkbook
Set Output_Sheet = ActiveWorkbook.ActiveSheet

input_fileName = Dir(folder_name & "TVP ENGINE 5.1" & "*.xlsm")

While input_fileName <> ""

'Weeding out the wrong files
If input_fileName Like "TVP ENGINE 5.1*" Then

    k_char_1 = InStr(1, input_fileName, "_", 1)
    k_char_2 = InStr(k_char_1 + 1, input_fileName, "_", 1)
    output_string_1 = Mid(input_fileName, k_char_1 + 1, 4)
    output_string_2 = Mid(input_fileName, k_char_2, Len(input_fileName) - k_char_2 - 4)

    j_lob = 0

    Set Input_File = Workbooks.Open(folder_name & input_fileName)
    Set Input_Sheet = Input_File.Worksheets("EMBEDDED_VALUE")
    Input_Sheet.Activate

    While j_lob < UBound(LOB) + 1

        With Input_Sheet.Range("B:B")
            Set seeker = .Find(LOB(j_lob), LookIn:=xlValues) 'Looks for titles of spreadsheets on a single Excel sheet
            i_input = seeker.Row
        End With

    'Instead of going through the entire Excel sheet, it finds specific spreadsheets on a single Excel sheet and looks
    'for specific labels in those spreadsheets to copy; labels are stored in array >lob_term<
        Select Case seeker 

        Case "TERM"

            j_input = 0

            Do

                output_string = output_string_1 & "_" & LOB(j_lob) & "_" & lob_term(j_input) & output_string_2
                Output_Sheet.Range("A" & i_output).Value = output_string 'Name for each row

            '*** Main Operation: copying ranges from one workbook to another***
                Input_Sheet.Range("D" & i_input + 2 & ":AT" & i_input + 2).Copy
                Output_Sheet.Range("B" & i_output & ":AQ" & i_output).PasteSpecial Paste:=xlPasteAll

                j_input = j_input + 1 'index for the lob_term array
                i_input = i_input + 1 'index for location on Input_Sheet
                i_output = i_output + 1 'index for location on Output_Sheet

            Loop Until j_input >= UBound(lob_term) + 1 'lob_term is a fixed value/fixed length array

            j_lob = j_lob + 1 'index for array of names of spreadsheets

    Case others

    '...[identical procedure for different cases]...

    End Select

    Wend

    'Close the current input file, define another
    Workbooks(input_fileName).Close SaveChanges:=False
    input_fileName = Dir()

Else

    input_fileName = Dir()

End If

Wend

   '[setting color theme, freezing panes, etc.]

Output_Fajl.Application.ScreenUpdating = True

    Output_File.SaveAs input_fileName:=output_name, FileFormat:=xlOpenXMLWorkbook
    Output_File.Close

Application.ScreenUpdating = True

End Sub

VBA：程序持续时间滞后于每个输入文件

0 个答案: