我有一个 Excel 工作簿,用户通过单击按钮导入文本文件。我的代码完全按照我的需要工作,但是在填写 H 列(阅读日期)时速度非常慢。这是我的 Excel 工作簿在将文本文件导入到 Excel 工作表时的样子:
vba - 加快 VBA 代码运行速度-LMLPHP

这是我的代码:

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

如果有人对我如何加快阅读日期的输入有任何建议,我将不胜感激!提前致谢!

最佳答案

我注意到的几件事

  • 正如 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
    

    这本身将提高您的代码速度,因为您在写入之前不再选择单元格。
  • 理想情况下,我会将范围复制到一个数组,然后对数组执行您正在执行的操作,然后将其写回单元格,但这就是我。
  • 删除不必要的代码行。不需要 ActiveWindow.SmallScroll Down:=0
  • 使用对象并完全限定您的对象。
  • 处理 Excel 行时,使用 Long 而不是 Integer
  • 关于vba - 加快 VBA 代码运行速度,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/44763554/

    10-14 18:19
    查看更多