Vba chạy rất chậm

[hoabattu3387]

Các bạn xem giúp mình có cách nào làm tăng tốc độ của đoạn code sau không ạ?
Mình mới tập tọe nên cà rốt quá!
Sub Oval1_Click()
Dim i, j, a, b, m, t, k As Integer
Dim arr(), arr1()
Application.ScreenUpdating = False
Set t24 = ThisWorkbook.Sheets("CHECK TIMEOUT")
Set way4 = ThisWorkbook.Sheets("way4")
t24.Columns("k:L").ClearContents
m = way4.Range("I65536").End(xlUp).Row
n = t24.Range("h65536").End(xlUp).Row
ReDim arr(1 To m, 1 To 6)
For t = 1 To m
arr(t, 1) = way4.Range("a" & t)
arr(t, 2) = Right(way4.Range("i" & t), 6)
arr(t, 3) = way4.Range("l" & t)
arr(t, 4) = way4.Range("t" & t)
Next


ReDim arr1(1 To n, 1 To 9)
For o = 1 To n
For p = 1 To 9
arr1(o, p) = t24.Cells(o, p)
Next
Next


For i = 1 To m
For j = 1 To n
If Application.And(arr(i, 2) = arr1(j, 8), arr1(j, 9) = "MAT") Then
arr(i, 6) = "time-out"
arr(i, 5) = arr1(j, 1)
Else
If Application.And(arr(i, 2) = arr1(j, 8), arr1(j, 9) = "") Then
For k = 1 To n
If arr1(k, 9) = "REVE" Then
arr(i, 6) = "Reverse"
arr(i, 5) = arr1(j, 1)
Else
End If
Next
Else
End If
End If


Next
Next
Set KETQUA = ThisWorkbook.Sheets("ket qua")
KETQUA.Columns("A:E").ClearContents
KETQUA.Columns("A:E").NumberFormat = "@"
KETQUA.Range("A1:f" & m) = arr
KETQUA.Range("E1") = "BUT TOAN"
KETQUA.Range("f1") = "KET QUA"
Application.ScreenUpdating = True
End Sub

Cảm ơn cả nhà nhiều ạ!

 

[SA_DQ]

Hiện tại bạn vẫn đang duyệt lần lượt trên từng trang tính lấy dữ liệu ở các cột cần thi61t đưa vô mảng;
Nhưng cũng có cách khác, như:

(Trang tính 'WAY4') bạn lấy dữ liệu của 20 cột đầu đưa vô mảng Arr1()
Sau đó duyệt trên mảng dữ liệu này để có dữ liệu các cột cần thiết đưa vô mảng Arr() (như bạn đang làm ở vòng lặp đầu tiên)

Ở trang tính thứ 2 cũng vậy, nên duyệt trên mảng sẽ nhanh hơn.

Mình nghĩ câu lệnh:

If Application.And(Arr(I, 2) = Arr1(J, 8), Arr1(J, 9) = "MAT") Then

là đi đường vòng không cần thiết; Bạn xài trực tiếp toán tử And trong VBA xem sao?

[b] If  Arr(I, 2) = Arr1(J, 8) And Arr1(J, 9) = "MAT" Then
[/b]

Thứ nữa, bạn cần khai báo các biến tường ming & đầy đủ thêm hơn; Lúc đó ta có thể xài lại biến sau mỗi vòng lặp.

Chúc vui & thành công!

 

[Let'GâuGâu]

Các bạn xem giúp mình có cách nào làm tăng tốc độ của đoạn code sau không ạ?


Cảm ơn cả nhà nhiều ạ!

cái này

If Application.And([COLOR=#ff0000]arr(i, 2) [/COLOR]= arr1(j, 8), arr1(j, 9) = "") Then

lấy ở đâu ra?

 

[sealand]

Cụ thể hơn ý kiến của bác HYen17 bạn tham khảo Code sau:

Option Explicit
Sub Oval1_Click()
Dim i, j, n, m, k As Integer
Dim arr, arr1
Application.ScreenUpdating = False
Sheet1.Columns("k:L").ClearContents
    m = Sheet2.Range("I65536").End(xlUp).Row - 1
    n = Sheet1.Range("h65536").End(xlUp).Row - 1
    arr = Sheet2.[A2:T2].Resize(m)
    For i = 1 To m
        arr(i, 2) = Right(arr(i, 9), 6)
        arr(i, 3) = arr(i, 12)
        arr(i, 4) = arr(i, 20)
        arr(i, 5) = ""
        arr(i, 6) = ""
    Next
    ReDim Preserve arr(1 To m, 1 To 6)
arr1 = Sheet1.[A2:I2].Resize(n)

For i = 1 To m
    For j = 1 To n
        If arr(i, 2) = arr1(j, 8) And arr1(j, 9) = "MAT" Then
            arr(i, 6) = "time-out"
            arr(i, 5) = arr1(j, 1)
        ElseIf arr(i, 2) = arr1(j, 8) And arr1(j, 9) = "" Then
            For k = 1 To n
                If arr1(k, 9) = "REVE" Then
                    arr(i, 6) = "Reverse"
                    arr(i, 5) = arr1(j, 1)
                End If
            Next
        End If
    Next
Next

With ThisWorkbook.Sheets("ket qua")
    .Columns("A:E").ClearContents
    .Columns("A:E").NumberFormat = "@"
    .Range("A2:f" & m + 1) = arr
    .Range("E1") = "BUT TOAN"
    .Range("f1") = "KET QUA"
End With
Application.ScreenUpdating = True
End Sub

 

[SA_DQ]

[thongbao]Cụ thể hơn ý kiến của bác HYen17 bạn tham khảo Code sau:
[/thongbao]
Anh chàng này thiệt kì đó nha;
Người ta đã viết Code ầm ầm thế kia mà còn "cầm tay chỉ việc" nữa!

Rỗi hơi chăng?

(/ui thôi nha, đùng giận mà tội nghiệp!

 

[sealand]

[thongbao]Cụ thể hơn ý kiến của bác HYen17 bạn tham khảo Code sau:
[/thongbao]
Anh chàng này thiệt kì đó nha;
Người ta đã viết Code ầm ầm thế kia mà còn "cầm tay chỉ việc" nữa!

Rỗi hơi chăng?

(/ui thôi nha, đùng giận mà tội nghiệp!

Em viết để test nhân thể chép lên luôn. Tài sản cả đời người là nhặt nhạnh mà, biết đâu có miếng nào dùng được thì cũng vui phải không bác?

 

[Let'GâuGâu]

Cụ thể hơn ý kiến của bác HYen17 bạn tham khảo Code sau:


[/CODE]

anh Sealand ơi
cái Arr(i,2) của chủ thớt lấy ở đâu vậy anh?
em dùng msgbox arr(i,2)
nó báo ra toàn dữ liệu rổng?
===========
à xin lổi thấy nó rồi
arr(i, 2) = Right(arr(i, 9), 6)

 

[sealand]

anh Sealand ơi
cái Arr(i,2) của chủ thớt lấy ở đâu vậy anh?
em dùng msgbox arr(i,2)
nó báo ra toàn dữ liệu rổng?
===========
à xin lổi thấy nó rồi
arr(i, 2) = Right(arr(i, 9), 6)

Bạn ấy gán dữ liệu rồi mà. Đây là lệnh gán:

arr(t, 2) = Right(way4.Range("i" & t), 6)

 

[Nguyễn Duy Tuân]

VBA mà không dùng đúng cách thì chậm thật nhưng phải biết cách, thuật toán tốt thì rất nhanh bạn nhé.

 

[hoabattu3387]

Cảm ơn bạn rất nhiều nhé!

 

[hoabattu3387]

Cảm ơn bạn nhiều nhé! mình sẽ thử xem!