加快VBA代码运行速度更快-SpeedingupVBACodetoRunFaster

I have an Excel Workbook where the user imports a text file by the click of a button. My code works exactly as I need it to but it is extremely slow when filling in column H, Reading Date. Here is what my Excel Workbook looks like when the text file has been imported to the excel sheet:

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

Here is my code:

这是我的代码:

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

If anyone has any suggestions as to how I can speed up the importation of the reading date I would appreciate it greatly! Thanks in advance!

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

3 个解决方案

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

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

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

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

YOUR CODE HERE

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

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