Question

我有一个“主文档”，并且整天从很多小文档中导入数据。我承认我不是一个超级天才，我的很多编码习惯都来自“老派”，所以可能有我不知道（但想学习！）的“ Excel方式”。 / p>

我看到的问题是导入数据文件需要花费多少时间。

启动该工具时，数据导入仅花费了几秒钟。

现在我有大约3500行数据，数据导入大约需要15-20秒。我要导入一行还是一百行都没关系。我希望这会继续上升。当我达到7000行或10,000行时，我希望它变得无法忍受。

通过使用消息框（请记住：“老派”），我已经能够将速度瓶颈缩小到两行代码。在“步骤1”和“步骤2”之间大约是我的延迟的30％，在“步骤2”和“步骤3”之间大约是我的延迟的70％。

我在下面包括了整个子内容，以确保我没有丢失明显的内容，但是我确保取消了我的消息框，以便您可以r-i-g-h-t转到我怀疑的代码。另外，我包括了整个替换项，因为通常第一个响应是“您可以显示整个替换项，以便我有更好的上下文吗？”

非常感谢您可能提出的任何想法或建议。：）

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

修改

我编辑了您的原始问题，以突出显示我发现的可疑事物。这些是我觉得值得向您指出的事情。我将其他所有内容都剔除掉，以专注于这些特定问题。复习它们并进行搜素研究，看看您是否可以找到更好的状况。

    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

看来您这里有很多美好的事物。我看到的几件事可能会更改以提高您的性能。

首先，在“步骤1”和“步骤2”之间：根据我的经验，添加行比使用已存在的行花费的时间更长。看起来您基本上是在“压低”所有内容以为新数据腾出空间，以便新输入的数据在顶部，而最旧的数据在底部。（如果我在任何方面都做错了，请改正我。）如果您只是将数据添加到工作表的末尾，则可能会看到一些性能方面的改进，尽管我不知道会有多大的改进

第二，在“步骤2”和“步骤3”之间：我发现使用.Value2而不是.Value可以给您带来一些性能改进，并且数据越大，改进越大。这是不利的一面-Value2不会保留任何可能存在的格式，这意味着数字类型（日期，会计等）不能正确使用。如果您不需要此功能，则可以使用Value2。

最后，其他方法：当我运行扩展宏时，我总是尽一切所能来提高性能。您可以使用关闭屏幕更新（Application.ScreenUpdating = False）之类的技巧来全面提升性能，只需确保在宏末尾将其重新打开即可。

我希望这可以帮助您解决问题！如果所有其他方法均失败，则可以手动执行一次或两次，以记住使用宏的速度有多快！哈哈。祝你好运！

Answer 2

您是否尝试过使用.value2？在某些情况下，它可能会为您带来更好的性能。在此处查看一些性能比较：https://fastexcel.wordpress.com/2011/11/30/text-vs-value-vs-value2-slow-text-and-how-to-avoid-it/

如果不访问原始工作表，很难知道问题出在哪里。也许问题出在数据本身而不是VBA代码，有时您可能需要清除繁重的源数据，然后在需要时再次添加。

您还可以考虑使用Python进行某些处理，但是如果您不想在解决方案中添加其他软件层，那我就不成问题了。

Answer 3

尝试在脚本的开头和结尾添加此内容。只需确保将所有内容都设置为TRUE ！！

Application.ScreenUpdating = False
Application.DisplayAlerts = False

...CODE HERE...

Application.ScreenUpdating = True
Application.DisplayAlerts = True

如何加快在Excel VBA中导入数据文件的速度

3 个答案: