Question

我在Excel-VBA中制作应用程序，但是当我有超过50,000条记录时，代码运行速度非常慢，格式化大约需要33秒。

Application.Interactive = False
Application.EnableEvents = False
Application.ScreenUpdating = False
'--------------- Tao Bien ------------------------------------------
Dim Dulieu() As Variant
Dim lastrow As Integer
Dim lastrowSC As Integer
Dim i, j As Integer
Dim NoDk, CoDk As Double
Dim PSNo As Double
Dim PSCo As Double
Dim NoCk As Double
Dim CoCk As Double
Dim TempArray() As Variant
Dim TheRange As Range
Dim Size As Integer
Dim TempArrayDao() As Variant
Dim lastrowTK As Integer
Dim TaiKhoan() As Variant
Dim FromDate As Date
Dim ToDate As Date


'--------------------Do Toc Do--------------------------------------
Dim Starttime As Double
Dim Code1 As Double
Dim Code2 As Double
Dim Code3 As Double
Dim Code4 As Double
Dim Code5 As Double
Dim Code6 As Double
Dim Code7 As Double
Starttime = Timer




'--------------- Xong Tao Bien --------------------------------------
NoDk = 0
CoDk = 0
PSNo = 0
PSCo = 0
NoCk = 0
CoCk = 0
lastrow = Sheet8.Cells(Rows.Count, "I").End(xlUp).Row

'Them so du dau ky----------------------------------------------------

lastrowTK = Sheet7.Cells(Rows.Count, "A").End(xlUp).Row
TaiKhoan = Sheet7.Range("A2:H" & lastrowTK)


For i = LBound(TaiKhoan) To UBound(TaiKhoan)
    If Sheet26.Cells(4, 4).Text = TaiKhoan(i, 1) Then
        NoDk = TaiKhoan(i, 3)
        CoDk = TaiKhoan(i, 4)
        Sheet26.Cells(5, 3).Value = "Tên tài kho" & ChrW(7843) & "n : " & TaiKhoan(i, 2)
        Exit For
    End If

Next

Code1 = Round(Timer - Starttime, 2)
'----------------------------------------------------------------------
Dim NoCongDon As Double
Dim CoCongDon As Double

Sheet26.Select
' Dua Du lieu vao Array Dulieu
Dulieu = Sheet8.Range("G2:N" & lastrow).Value
FromDate = Sheet26.Cells(6, 3).Value
ToDate = Sheet26.Cells(7, 3).Value
Size = 1
ReDim TempArray(1 To 6, 1 To Size)
Dim tk As String
tk = Sheet26.Cells(4, 4).Text
For i = 1 To UBound(Dulieu)
    If ((StrComp(Left(tk, Len(Trim(tk))), Left(Dulieu(i, 6), Len(Trim(tk))), vbTextCompare) = 0) Or _
    (StrComp(Left(tk, Len(Trim(tk))), Left(Dulieu(i, 7), Len(Trim(tk))), vbTextCompare) = 0)) Then

        If (StrComp(Left(tk, Len(Trim(tk))), Left(Dulieu(i, 6), Len(Trim(tk))), vbTextCompare) = 0) Then
            If Dulieu(i, 3) < FromDate Then
            NoCongDon = NoCongDon + Dulieu(i, 8)
            ElseIf Dulieu(i, 3) = FromDate Or Dulieu(i, 3) <= ToDate Then
            TempArray(1, Size) = Dulieu(i, 1)
            TempArray(2, Size) = Dulieu(i, 3)
            TempArray(3, Size) = Dulieu(i, 5)
            TempArray(4, Size) = Dulieu(i, 7)
            TempArray(5, Size) = Dulieu(i, 8)
            Size = Size + 1
            ReDim Preserve TempArray(1 To 6, 1 To Size)
            End If
        Else
            If Dulieu(i, 3) < FromDate Then
            CoCongDon = CoCongDon + Dulieu(i, 8)
            ElseIf Dulieu(i, 3) = FromDate Or Dulieu(i, 3) <= ToDate Then
            TempArray(1, Size) = Dulieu(i, 1)
            TempArray(2, Size) = Dulieu(i, 3)
            TempArray(3, Size) = Dulieu(i, 5)
            TempArray(4, Size) = Dulieu(i, 6)
            TempArray(6, Size) = Dulieu(i, 8)
            Size = Size + 1
            ReDim Preserve TempArray(1 To 6, 1 To Size)
            End If
        End If


    End If
Next i

Code2 = Round(Timer - Starttime, 2)
'Dao lai Array Tam
ReDim TempArrayDao(1 To Size, 1 To 6)
For i = 1 To Size
    For j = 1 To 6
        TempArrayDao(i, j) = TempArray(j, i)
    Next
Next
k = UBound(TempArrayDao) + 14

'Add value to my sheet
Set TheRange = Sheet26.Range("A15:F" & k)
TheRange.Value = TempArrayDao

格式化我的工作表，花了33秒来格式化我的工作表，我不知道为什么......

With Sheet26
    With .Range("A14:F" & k + 1)
        .ClearFormats
        .Borders.LineStyle = xlContinuous
     End With
Code4 = Round(Timer - Starttime, 2) ' code4 is 0.4 s
    With .Range("C14:C" & k)
        .WrapText = True
        .Rows.AutoFit
        .VerticalAlignment = xlCenter
    End With

Code5 = Round(Timer - Starttime, 2) 'code5 is 13,14s
    .Range("A14:B" & k).HorizontalAlignment = xlCenter
    .Range("A14:B" & k).VerticalAlignment = xlCenter

    With .Range("D14:D" & k)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .NumberFormat = "@"
    End With

    With .Range("E14:F" & k + 1)
        .NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
        .VerticalAlignment = xlCenter

    End With
    .Range("C" & k & ":C" & k + 1).HorizontalAlignment = xlCenter
    .Range("B14:B" & k).NumberFormat = "dd/mm/yyyy"

Code6 = Round(Timer - Starttime, 2) ' code6 is 33,97 s
End With


With Sheet26.Range("A" & k & ":F" & k + 1)
    .Interior.ThemeColor = xlThemeColorDark2
    .Font.Bold = True
End With
ReDim Dulieu(0, 0) As Variant
ReDim TempArray(0, 0) As Variant
Set TheRange = Nothing
ReDim TempArrayDao(0, 0) As Variant
ReDim TaiKhoan(0, 0) As Variant
Application.Interactive = True
Application.EnableEvents = True
Application.ScreenUpdating = True

为什么我的VBA脚本格式化Excel表格非常慢？

0 个答案: