Question

我有一个Excel工作簿，用户可以通过单击按钮导入文本文件。我的代码完全按照我的需要工作，但填写H列，阅读日期时速度非常慢。以下是将文本文件导入Excel工作表时Excel工作簿的外观：

这是我的代码：

Sub Import_Textfiles()
Dim fName As String, LastRow As Integer

Worksheets("Data Importation Sheet").Activate

LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    ' Finds the first blank row to import text file data to
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If fName = "False" Then Exit Sub

  With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("A" & LastRow))
        .Name = "2001-02-27 14-48-00"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 2
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(14, 14, 8, 16, 12, 14)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.SmallScroll Down:=0


    Dim strShortName As String


    'Adding Reading Date to Excel Sheet:
    Dim rowCount As Integer, currentRow As Integer
    Dim sourceCol As Integer, nextCol As Integer
    Dim currentRowValue As String
    Dim fileDate1 As String
    Dim fileDate2 As String

    sourceCol = 1 'columnA
    nextCol = 8 'column H
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    strShortName = fName
    fileDate1 = Mid(fName, InStrRev(fName, "\") + 1)
    fileDate2 = Left(fileDate1, 10)

    Cells(LastRow, 9) = ("Updating Location: " & strShortName)

    For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, nextCol).Value
        If currentRowValue = "" Then
        Cells((currentRow), (nextCol)).Select
        Cells((currentRow), (nextCol)) = fileDate2
        End If
    Next

End Sub

如果有人对如何加快阅读日期的输入有任何建议，我会非常感激！提前谢谢！

Answer 1

我注意到的一些事情

正如Chris在评论中提到的那样，您可以关闭屏幕更新并将计算设置为手动并重新打开它们，并在代码结束时将计算设置为自动。

例如

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'
'~~> Rest of your code
'
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

避免使用.Select。它降低了代码的速度。您无需选择要写入的单元格。

您的For循环可以写为。

For currentRow = 1 To RowCount
    If Cells(currentRow, nextCol).Value = "" Then
        Cells(currentRow, nextCol).Value = fileDate2
    End If
Next

这样可以提高代码的速度，因为在写入代码之前不再选择单元格。

理想情况下，我会将范围复制到数组，然后执行您对数组所做的操作，然后将其写回单元格，但那就是我。
删除不必要的代码行。
使用对象并完全限定对象。
使用Excel行时，请使用ActiveWindow.SmallScroll Down:=0代替Long

Answer 2

试试这个：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

YOUR CODE HERE

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

Answer 3

最佳解决方案取决于一些事情，我从提供的数据中无法清楚。以下更改将加速它（选择单元格需要花费很多时间），但它不是最佳的。如果它仍然变慢，请提供〜行数和〜％行（在H列中），在您到达以下代码之前填充这些行。然后搜索缺失值或（可能在大多数情况下）将列H复制到数组中并在更新值后复制回来将会起到作用。

旧代码：

For currentRow = 1 To rowCount
    currentRowValue = Cells(currentRow, nextCol).Value
    If currentRowValue = "" Then
    Cells((currentRow), (nextCol)).Select
    Cells((currentRow), (nextCol)) = fileDate2
    End If
Next

新代码：

For currentRow = 1 To rowCount
    if Cells(currentRow, nextCol).Value = "" then
        Cells(currentRow,nextCol).Value = fileDate2
    End If
Next

加快VBA代码运行速度更快

3 个答案: