Как ускорить импорт файла данных в Excel VBA

Question

Обновление от 11 июня 2019 г. Я до сих пор не понял, почему практически все мои задержки происходят в этих двух строках, но в настоящее время я терплю задержку.На данный момент у меня есть около 6000 строк данных в главном документе, и процесс импорта занимает около 20 секунд, независимо от того, сколько строк я импортирую.

-

У меня есть"главный документ", и я импортирую данные из множества маленьких документов в течение всего дня.Я признаю, что я здесь не супер-гений, и многие мои привычки в коде проистекают из «старой школы», поэтому могут быть «способы Excel», которых я не знаю (но хочу изучать!).

Проблема, которую я вижу, заключается в том, сколько времени может занять импорт файла данных.

Когда я запустил инструмент, импорт данных занял всего несколько секунд.

Сейчасчто у меня около 3500 строк данных, импорт данных занимает около 15-20 секунд.Не имеет значения, импортирую ли я одну строку или сто строк.Я ожидаю, что это будет продолжать расти.К тому времени, когда я доберусь до 7000 строк или 10000 строк, я ожидаю, что это станет невыносимым.

Используя окна сообщений (помните: «старая школа»), я смог сузить узкое место в скорости додве строки кода.Между «Шагом 1» и «Шагом 2» находится около 30% моей задержки, а между «Шагом 2» и «Шагом 3» - около 70% моей задержки.

Я включил весь сабвуферниже, чтобы убедиться, что я не пропустил что-то очевидное, но я позаботился о том, чтобы ОТКЛЮЧИТЬ свои окна сообщений, чтобы вы могли перейти прямо к коду, который я подозреваю.Кроме того, я включил всю сабвуфер, потому что обычно один из первых ответов - «Можете ли вы показать весь саб, чтобы у меня был лучший контекст?»

Спасибо за любые мысли или предложения, которые могут у вас возникнуть.:)

Private Sub Btn_ImportDataFiles_Click()
  ' Search the current worksheet and assign the next TransactionID
    Dim TransactionCounter As Integer
    Dim TransactionID As Long ' This is the next available Transaction ID
    TransactionID = Application.WorksheetFunction.Max(Range("a:a")) + 1
  ' open the file and import the data
    Dim customerBook As Workbook
    Dim filter As String
    Dim caption As String
    Dim customerFilename As String
    Dim customerWorkbook As Workbook
    Dim targetWorkbook As Workbook

    ' make weak assumption that active workbook is the target
      Set targetWorkbook = Application.ActiveWorkbook

    ' get the customer workbook
      filter = "Text files (*.xlsx),*.xlsx"
      caption = "Please Select an input file "
      customerFilename = Application.GetOpenFilename(filter, , caption)

    If customerFilename <> "False" Then
    ' If they have uploaded the file before, let them know.
    ' If they want to keep uploading it, no harm done,
    ' but no need to stupidly add data that is already present.
    ' Select the archive sheet
      Sheets("Upload_Archive").Select
      Dim FileNameHunt As String
      Dim cell As Range
      Dim ContinueUpload As Boolean
      ContinueUpload = True
      FileNameHunt = Mid(customerFilename, InStrRev(customerFilename, "\") + 1)
      Columns("A:A").Select
      Set cell = Selection.Find(what:=FileNameHunt, after:=ActiveCell, LookIn:=xlFormulas, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
      If cell Is Nothing Then ' Add the new filename to the archive
        Sheets("Upload_Archive").Select
        Rows(1).Insert shift:=xlDown
        Range("a1:a1").Value = FileNameHunt
        Sheets("MasterSheet").Select
        Application.Cells.Font.Name = "Calibri Light"
        Application.Cells.Font.Size = "8"
        Application.Cells.Font.Bold = False
      Else
        response = MsgBox("This data file has previously been uploaded. " & vbCrLf & "Do you want to cancel this upload?" & vbCrLf & vbCrLf & "Pressing [yes] will cancel the process." & vbCrLf & "Pressing [no] will continue with the file upload" & vbCrLf & "and add the data to the tracking sheet.", vbYesNo)
        If response = vbYes Then
          ContinueUpload = False
          Sheets("MasterSheet").Select
          Exit Sub
        End If
      End If ' If cell Is Nothing Then...

      If ContinueUpload = True Then
        ' Continue with data upload procedure
          Sheets("MasterSheet").Select
          Set customerWorkbook = Application.Workbooks.Open(customerFilename)
        ' Copy data from customer to target workbook
          Dim targetSheet As Worksheet
          Set targetSheet = targetWorkbook.Worksheets(1)
          Dim sourceSheet As Worksheet
          Set sourceSheet = customerWorkbook.Worksheets(1)
          Dim ImportRecordCount As Integer
          ImportRecordCount = sourceSheet.Range("B1")
          Dim ReconciliationID As String
          ReconciliationID = ""
          If sourceSheet.Range("E3") = "Removed from Depot" Then ReconciliationID = "1"
MsgBox ("Step 1")
          targetSheet.Range("A1").EntireRow.Offset(1).Resize(ImportRecordCount).Insert shift:=xlDown ' Add the blank rows
MsgBox ("Step 2")
          targetSheet.Range("B2:AB" & ImportRecordCount + 1).Value = sourceSheet.Range("A3:AA" & ImportRecordCount + 2).Value ' Bring in the big pile of data
MsgBox ("Step 3")
          targetSheet.Range("AJ2:AJ" & ImportRecordCount + 1).Value = ReconciliationID ' To help with reconciling shipments
          targetSheet.Range("AK2:AK" & ImportRecordCount + 1).Value = ReconciliationID ' To help with deployment timing
          'targetSheet.Range("AI2:AI" & ImportRecordCount + 1).Value = "=COUNTIFS($D:$D, D2, $F:$F, F2)" ' This is the helper formula for identifying duplicates (deprecated, but I'm saving the code)
          For TransactionCounter = 2 To ImportRecordCount + 1 ' Create and add the new Transaction ID values
            targetSheet.Range("a" & TransactionCounter) = TransactionID + ImportRecordCount - TransactionCounter + 1
          Next
        ' Close customer workbook
          customerWorkbook.Close
        ' Format the sheet properly
          Application.Cells.Font.Name = "Calibri Light"
          Application.Cells.Font.Size = "8"
          Application.Cells.Font.Bold = False
          Application.Range("1:1").Font.Size = "10"
          Application.Range("1:1").Font.Bold = True
        ' Query the User -- delete the file?
          If MsgBox("Delete the local client-generated data file?" & vbCrLf & vbCrLf & "(this will NOT affect your email)", vbYesNo, "Confirm") = vbYes Then
            Kill customerFilename
            ' MsgBox ("File: " & vbCrLf & customerFilename & vbCrLf & "has been deleted.")
          End If
      End If ' If ContinueUpload = True Then
    End If ' If customerFilename <> "False" Then

End Sub

edit

Я отредактировал ваш первоначальный вопрос, чтобы выделить вещи, которые я нашел подозрительными.Это то, что я чувствовал, стоит указать тебе.Я побрил все остальное, чтобы сосредоточиться на этом конкретном вопросе.Просмотрите их и проведите исследование, чтобы выяснить, сможете ли вы оказаться в лучшем положении.

    MsgBox ("Step 2")

        'Ive never moved large amounts of data using this method. Ive always just used arrays. I have moved smaller bits of data though.
        ' I suspect that this might take a moment if the data set is large. Again use arrays to grab the data and move it.
        ' Edward says “This step takes about 70% of my delay — even if bringing in only a single line of data.”

        targetSheet.Range("B2:AB" & ImportRecordCount + 1).Value = sourceSheet.Range("A3:AA" & ImportRecordCount + 2).Value ' Bring in the big pile of data

    MsgBox ("Step 3")

      ' this loop is probably your main culprit of your performance issue. 
      ' Edward says “Nope, this flies by. It is not the issue at all. I have verified this already.”
      ' Learn how to construct an array of data on the fly and then learn how to dump the entire array to 
      ' sheet using a simple method.

        For TransactionCounter = 2 To ImportRecordCount + 1 ' Create and add the new Transaction ID values
            targetSheet.Range("a" & TransactionCounter) = TransactionID + ImportRecordCount - TransactionCounter + 1
        Next

Answer 1

Попробуйте добавить это в начале и конце вашего скрипта. Просто убедитесь, что все установлено на TRUE !!

Application.ScreenUpdating = False
Application.DisplayAlerts = False

...CODE HERE...

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Answer 2

Похоже, у тебя здесь много хорошего. Несколько вещей, которые я видел, которые потенциально могут быть изменены, чтобы улучшить вашу производительность.

Во-первых, между «Шагом 1» и «Шагом 2»: По моему опыту, добавление строк занимает больше времени, чем использование уже существующих строк. Похоже, вы в основном «толкаете» все вниз, чтобы освободить место для новых данных, так что вновь введенные данные находятся вверху, а самые старые данные - внизу. (Поправьте меня, если я ошибаюсь по любому из этих вопросов.) Если бы вы просто добавили данные в конец таблицы, вы, вероятно, увидели бы некоторые улучшения производительности, хотя я не знаю, насколько значительным было бы улучшение .

Во-вторых, между «Шагом 2» и «Шагом 3»: я обнаружил, что использование .Value2 вместо .Value может дать вам некоторые улучшения производительности, и чем больше данные, тем больше улучшение. У этого есть обратная сторона - Value2 не сохраняет ни одно из форматирования, которое может присутствовать, а это означает, что тип числа (дата, учет и т. Д.) Не выполняется корректно. Если это то, что вам не нужно, то вы можете использовать Value2.

Наконец, другие методы: когда я запускаю обширные макросы, я всегда стараюсь сделать все возможное, чтобы повысить производительность. Вы можете получить небольшое повышение по всей доске, используя такие приемы, как отключение обновления экрана (Application.ScreenUpdating = False), просто обязательно включите его снова в конце макроса.

Я надеюсь, что это поможет вам разобраться! Если ничего не помогает, вы можете сделать это один или два раза вручную, чтобы вспомнить, насколько быстрее он использует макрос! Ха-ха. Удачи!