Muốn code chạy nhanh hơn

Liên hệ QC
T

thaibinh_excel

Thành viên hoạt động
Tham gia
18/10/07
Bài viết
127
Được thích
29
Nghề nghiệp
Bán Hàng
Cho mình hỏi thông thường tốc độ chạy của code VBA và công thức thì như thế nào a? Muốn code chạy nhanh hơn thì phải viết riêng cho code đó thêm 1 phần nữa hay có cách nào áp dụng chung không a?

Ví dụ mình đang sử dụng 1 code này, muốn nó chạy nhanh hơn thì phải làm sao ? Dữ liệu update khoảng 500 dòng.

PHP: 
Sub Updates()
    Dim endR As Integer, iR As Integer, jR As Integer, k As Integer, i As Integer
    Dim Data As Range
    Dim Pro As String, Pur As String
    With Application
        .ScreenUpdating = False
    End With
    Worksheets("Products").Select
    Range("P1:W10000").ClearContents
    Range("K5:N10000").ClearContents    'xoa kq'
    endR = [B65000].End(xlUp).Row
    'Chuyen qua vung tmp de sort'
    Range("T4:W4").Value = Range("B3:E3").Value    'Tieude'
    Range("T5:W" & endR).Value = Range("B5:E" & endR).Value
    Pur = "":                                Pro = ""
    Cat = "":                               Set Data = Range("T4:W" & endR)
    With Data    'Sort'
        .Sort Key1:=Range("T5"), Order1:=xlAscending, Key2:=Range("U5") _
            , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
              False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
                                                                          :=xlSortNormal
    End With
    k = 5
    For i = endR To 5 Step -1
        If Range("T" & i) = Range("T" & i - 1) Then
            Pur = Pur & " " & Range("U" & i)
            Pro = Pro & " " & Range("V" & i)
            Cat = Cat & " " & Range("W" & i)
        Else
            'gan du lieu'
            Pur = Pur & " " & Range("U" & i)
            Pro = Pro & " " & Range("V" & i)
            Cat = Cat & " " & Range("W" & i)
            Range("K" & k) = Range("T" & i)    'CusID'
            Range("L" & k) = Pur    'PurID'
            Range("M" & k) = Pro    'Pro '
            Range("N" & k) = Cat    'Cat '
            Pur = "":                                  Pro = ""
            Cat = "":                                  k = k + 1
        End If
    Next
    jR = [K10000].End(xlUp).Row
    Set Data = Range("K5:N" & jR)    'Sort lai KQ'
    With Data
        .Sort Key1:=Range("K5"), Order1:=xlAscending, Header:=xlGuess, _
              OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
              DataOption1:=xlSortNormal
    End With
    Set Data = Nothing
    Range("P1:W10000").ClearContents

    With Application
        .ScreenUpdating = False
    End With

End Sub

( code này do anh ThuNghi làm giúp mình )

cám ơn mọi người.
TB
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mình không rõ lắm về thực chất của Code trên, tuy nhiên chỉ xin rút gọn dựa trên cái mà bạn cho biết thôi.

PHP: 
Sub Updates()
    Dim endR As Integer, k As Integer, i As Integer
    Dim Pro As String, Pur As String, Cat As String
    Application.ScreenUpdating = False
    Worksheets("Products").Select
    Range("K5:N10000 ").ClearContents    'xoa kq'
    endR = [B65000].End(xlUp).Row
    'Chuyen qua vung tmp de sort'
    Range("T4:W4").Value = Range("B3:E3").Value    'Tieude'
    Range("T5:W" & endR).Value = Range("B5:E" & endR).Value
    Range("T4:W" & endR).Sort Key1:=Range("T5"), Order1:=xlAscending, Key2:=Range("U5") _
                            , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                              False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    k = 5
    For i = endR To 5 Step -1
        Pur = Pur & " " & Range("U" & i)
        Pro = Pro & " " & Range("V" & i)
        Cat = Cat & " " & Range("W" & i)
        If Range("T" & i) <> Range("T" & i - 1) Then
            'gan du lieu'
            Range("K" & k) = Range("T" & i)    'CusID'
            Range("L" & k) = Pur    'PurID'
            Range("M" & k) = Pro    'Pro'
            Range("N" & k) = Cat    'Cat'
            Pur = ""
            Pro = ""
            Cat = ""
            k = k + 1
        End If
    Next
    'Sort lai KQ'
    Range("K5:N" & [K10000].End(xlUp).Row).Sort Key1:=Range("K5"), Order1:=xlAscending, Header:=xlGuess, _
              OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
              DataOption1:=xlSortNormal
    Range("P1:W10000").ClearContents
    Application.ScreenUpdating = False

End Sub

Thân!
 
Upvote 0
Mr Okebab đã viết:
Mình không rõ lắm về thực chất của Code trên, tuy nhiên chỉ xin rút gọn dựa trên cái mà bạn cho biết thôi.

PHP: 
Sub Updates()
    Dim endR As Integer, k As Integer, i As Integer
    Dim Pro As String, Pur As String, Cat As String
    Application.ScreenUpdating = False
    Worksheets("Products").Select
    Range("K5:N10000 ").ClearContents    'xoa kq'
    endR = [B65000].End(xlUp).Row
    'Chuyen qua vung tmp de sort'
    Range("T4:W4").Value = Range("B3:E3").Value    'Tieude'
    Range("T5:W" & endR).Value = Range("B5:E" & endR).Value
8    Range("T4:W" & endR).Sort Key1:=Range("T5"), Order1:=xlAscending, Key2:=Range("U5") _
                            , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                              False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    k = 5
    For i = endR To 5 Step -1
        Pur = Pur & " " & Range("U" & i)
        Pro = Pro & " " & Range("V" & i)
        Cat = Cat & " " & Range("W" & i)
        If Range("T" & i) <> Range("T" & i - 1) Then
            'gan du lieu'
            Range("K" & k) = Range("T" & i)    'CusID'
            Range("L" & k) = Pur    'PurID'
            Range("M" & k) = Pro    'Pro'
            Range("N" & k) = Cat    'Cat'
            Pur = ""
            Pro = ""
            Cat = ""
            k = k + 1
        End If
    Next
    'Sort lai KQ'
9    Range("K5:N" & [K10000].End(xlUp).Row).Sort Key1:=Range("K5"), Order1:=xlAscending, Header:=xlGuess, _
              OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
              DataOption1:=xlSortNormal
    Range("P1:W10000").ClearContents
    Application.ScreenUpdating = False

End Sub
Thân!
Nhấp chuột vào đây để mở rộng...

Thanks Bác,
Cái em muốn làm nằm ở đề tài này ạ. Em chỉ thắc mắc là dùng VBA sao code chạy lâu quá, loại dữ liệu này em mới có khoảng 30 dòng mà nó chuyển mất 12p, nếu nhiều hơn thì sợ sẽ rất lâu, không biết có cách nào tăng tốc việc xử lý không ạ
http://www.giaiphapexcel.com/forum/showthread.php?t=12054
 
Upvote 0
Tôi thấy đoạn code trên tốt, không phải là nguyên nhân chính chạy chậm. Rất có thể con file của bạn sử dụng nhiều name động hoặc có nhiều lệnh viết trong các sự kiện của Worksheet.
Bạn bổ sung thêm lệnh này vào cùng cặp với Application.ScreenUpdating
Application.EnableEvents = False
....
EndSub:
Application.EnableEvents = True
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Mr Okebab đã viết:
Mình không rõ lắm về thực chất của Code trên, tuy nhiên chỉ xin rút gọn dựa trên cái mà bạn cho biết thôi.

PHP: 
Sub Updates()
    Dim endR As Integer, k As Integer, i As Integer
    Dim Pro As String, Pur As String, Cat As String
    Application.ScreenUpdating = False
    Application.EnableEvents = False  
    Worksheets("Products").Select
    Range("K5:N10000 ").ClearContents    'xoa kq'
    endR = [B65000].End(xlUp).Row
    'Chuyen qua vung tmp de sort'
    Range("T4:W4").Value = Range("B3:E3").Value    'Tieude'
    Range("T5:W" & endR).Value = Range("B5:E" & endR).Value
    Range("T4:W" & endR).Sort Key1:=Range("T5"), Order1:=xlAscending, Key2:=Range("U5") _
                            , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                              False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    k = 5
    For i = endR To 5 Step -1
        Pur = Pur & " " & Range("U" & i)
        Pro = Pro & " " & Range("V" & i)
        Cat = Cat & " " & Range("W" & i)
        If Range("T" & i) <> Range("T" & i - 1) Then
            'gan du lieu'
            Range("K" & k) = Range("T" & i)    'CusID'
            Range("L" & k) = Pur    'PurID'
            Range("M" & k) = Pro    'Pro'
            Range("N" & k) = Cat    'Cat'
            Pur = ""
            Pro = ""
            Cat = ""
            k = k + 1
        End If
    Next
    'Sort lai KQ'
    Range("K5:N" & [K10000].End(xlUp).Row).Sort Key1:=Range("K5"), Order1:=xlAscending, Header:=xlGuess, _
              OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
              DataOption1:=xlSortNormal
    Range("P1:W10000").ClearContents
    Application.ScreenUpdating = False

End Sub:
 			 				Application.EnableEvents = True
Thân!
Nhấp chuột vào đây để mở rộng...

Thanks bác Tuan,
Em bổ sung như thế này có đúng không a.?
 
Upvote 0
Gần đúng rồi :) Cuối thủ tục là:
On Error Goto EndSub:
Application.ScreenUpdating = False
Application.EnableEvents = False

....
....
....
EndSub: 'an toàn khi có lỗi vẫn hoàn trả được giá trị
Application.ScreenUpdating = True
Application.EnableEvents = True
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
TuanVNUNI đã viết:
Gần đúng rồi :) Cuối thủ tục là:
Nhấp chuột vào đây để mở rộng...
Aha, vậy là phần trên okie, phần dưới sẽ sửa như thế này phải k a.?
......
Range("P1:W10000").ClearContents
 On Error Goto EndSub:
Application.ScreenUpdating = False
Application.EnableEvents = False

....
....
....
EndSub: 'an toàn khi có lỗi vẫn hoàn trả được giá trị
Application.ScreenUpdating = True
Application.EnableEvents = True

hay là như thế này mới đúng ạ?
Dim Pro As String, Pur As String, Cat As String
On Error Goto EndSub:
Application.ScreenUpdating = False
Application.EnableEvents = False
.......
.....
......
Range("P1:W10000").ClearContents
 Application.ScreenUpdating = False
Application.EnableEvents = False
EndSub: 'an toàn khi có lỗi vẫn hoàn trả được giá trị
Application.ScreenUpdating = True
Application.EnableEvents = True

Bác Tuan chỉ giúp với. :-)
Thanks bác,
 
Upvote 0
Mã: 
 hay là như thế này mới đúng ạ?
Dim Pro As String, Pur As String, Cat As String
On Error Goto EndSub:
Application.ScreenUpdating = False
Application.EnableEvents = False
.......
.....
......
Range("P1:W10000").ClearContents
Application.ScreenUpdating = False
Application.EnableEvents = False
EndSub: 'an toàn khi có lỗi vẫn hoàn trả được giá trị
Application.ScreenUpdating = True
Application.EnableEvents = True
Như vậy thì mới có tác dụng chứ
 
Upvote 0
thaibinh_excel đã viết:
Aha, vậy là phần trên okie, phần dưới sẽ sửa như thế này phải k a.?
......
Range("P1:W10000").ClearContents
 On Error Goto EndSub:
Application.ScreenUpdating = False
Application.EnableEvents = False

....
....
....
EndSub: 'an toàn khi có lỗi vẫn hoàn trả được giá trị
Application.ScreenUpdating = True
Application.EnableEvents = True

hay là như thế này mới đúng ạ?
Dim Pro As String, Pur As String, Cat As String
On Error Goto EndSub:
Application.ScreenUpdating = False
Application.EnableEvents = False
.......
.....
......
Range("P1:W10000").ClearContents
 Application.ScreenUpdating = False
Application.EnableEvents = False
EndSub: 'an toàn khi có lỗi vẫn hoàn trả được giá trị
Application.ScreenUpdating = True
Application.EnableEvents = True

Bác Tuan chỉ giúp với. :-)
Thanks bác,
Nhấp chuột vào đây để mở rộng...

Chỉ cần thế này thôi

PHP: 
Sub ABC()
    On Error GoTo EndSub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim Pro As String, Pur As String, Cat As String
    
    .......
    '''''''   CODE CUA BAN   '''''''''''''''''''
    ......

EndSub:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Thân!
 
Upvote 0
Xin các bạn chú ý cho:
Một số thuộc tính như DisplayAlerts, ScreenUpdating sẽ tự động trả về TRUE sau khi thực hiện thủ tục và trả quyền về cho người sử dụng.

Lê Văn Duyệt
PS: Đón đọc eBook - Range All :D
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

gamo_excel
Hàm Index trả về nhiều kết quả
Trả lời
12
Đọc
1K
VetMini
V
N
tắt bảo vệ trang tính
Trả lời
2
Đọc
20
ngọcanh@123
N
tuv8x
Xin hỏi cách giới hạn vùng làm việc
Trả lời
1
Đọc
21
ptm0412
ptm0412
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2
Trả lời
33
Đọc
12K
tnson1
tnson1
X
Đường lưới trong file excel bị mất
Trả lời
11
Đọc
8K
GREEN HOTEL CO
GREEN HOTEL CO
C
Tìm dữ liệu khác nhau trong 2 file hoặc 2 sheet trong excel
Trả lời
1
Đọc
65
vanle33
vanle33
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
2
Trả lời
23
Đọc
1K
CHAOQUAY
C
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
1
Đọc
93
HeSanbi
HeSanbi
T
Game xóc đĩa trên excel
    • Cười
Trả lời
11
Đọc
2K
SA_DQ
SA_DQ
Ljxxerti
Mình hỏi về hàm excel
Trả lời
1
Đọc
59
bebo021999
B
Lyvanduong
  • Question Question
Mn cho em hỏi với lỗi 1004 ở Excel này thì xử lí như nào ạ
Trả lời
2
Đọc
90
HeSanbi
HeSanbi
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
1
Đọc
82
yaaasoo01
Y
D
Paste dữ liệu, bỏ qua các cell ẩn
2
Trả lời
28
Đọc
45K
HeSanbi
HeSanbi
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
9
Đọc
185
vuonghienst92
V
D
In sheet trong excel chi ra giấy trắng
Trả lời
7
Đọc
12K
binhht79
B
H
  • Question Question
[Help]làm cách nào để đếm không trùng thỏa 1 điều kiện
Trả lời
1
Đọc
71
hoangtuaotrang_hp_vn
H
minhminh040499
Filter không hoạt động.
    • Cười
Trả lời
7
Đọc
155
minhminh040499
minhminh040499
D
  • Question Question
Lỗi run-time error '1004'
2
Trả lời
21
Đọc
45K
Lyvanduong
Lyvanduong
K
Cảnh báo add-in có virus
    • Thích
    • Cười
Trả lời
13
Đọc
590
hoangtuan.net
hoangtuan.net
tedaynui
Giúp công thức : lấy dòng và giá trị ô đầu tiên trong cột
2
Trả lời
21
Đọc
10K
Khúc Thanh Sinh
K
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom