Nhờ giúp sửa code bị chậm

[Dang Le Khanh Ninh]

Xin chào cả nhà. Em là thành viên mới. Em mới tập tọe lập trình. Nay em có viết đoạn code để cập nhật dữ liệu. Em sử dụng 2 vòng lặp for lồng nhau. Khi em chạy chương trình mất tận 20 phút lận. Các cao thủ chỉ giáo giúp em với ạ. Chi tiết các bác xem attach file ạ.
Đoạn code của em như sau:

Sub Check_Fabric_Contract()
Dim Row_Order As Variant
Dim Row_Fabric As Variant
Dim i, j As Integer
Dim Fabric_filter As String
Dim PO_filter As String
Dim Row_Copy As Variant
Dim Find_PO As Double
Dim Find_Fabric As Double
Dim Compare_SheetsFabric1 As Variant
Dim Compare_SheetsFabric2 As Variant
Dim Compare_SheetOrder1 As Variant
Dim Compare_SheetOrder2 As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual

'Compare_format'
Sheets("Fabric contract").Select
Compare_SheetFabric1 = WorksheetFunction.Concat(Sheets("Fabric contract").Range("A1:W1"))
Compare_SheetFabric2 = WorksheetFunction.Concat(Sheets("Fabric contract").Range("A2:W2"))
Sheets("Order list").Select
Compare_SheetOrder1 = WorksheetFunction.Concat(Sheets("Order list").Range("A1:W1"))
Compare_SheetOrder2 = WorksheetFunction.Concat(Sheets("Order list").Range("A2:W2"))

If Compare_SheetFabric1 = Compare_SheetFabric2 And Compare_SheetOrder1 = Compare_SheetOrder2 Then

    'Define quantity of Row in Fabric contract'
    Sheets("Fabric contract").Select
    If AutoFilterMode = True Then AutoFilterMode = False
    Sheets("Fabric contract").Range("A3").Select
    Sheets("Fabric contract").Range(Selection, Selection.End(xlDown)).Select
    Row_Fabric = Selection.Count + 2
 
    'Define quantity of Row in Order list'
    Sheets("Order list").Select
    If AutoFilterMode = True Then AutoFilterMode = False
    Sheets("Order list").Range("C2").Select
    Sheets("Order list").Range(Selection, Selection.End(xlDown)).Select
    Row_Order = Selection.Count + 1
 
    'Run program'
    For i = 1 To Row_Fabric - 3
    For j = 1 To Row_Order - 2
    Sheets("Fabric contract").Select
    Fabric_filter = Sheets("Fabric contract").Range("H" & i + 2).Text
    PO_filter = Sheets("Fabric contract").Range("D" & i + 2).Text
    Sheets("Order list").Select
    If AutoFilterMode = True Then AutoFilterMode = False
    Sheets("Order list").Select
    Find_Fabric = Application.IfError(Application.Search(Fabric_filter, Sheets("Order list").Range("K" & j + 2).Text, 1), 0)
    Find_PO = Application.IfError(Application.Search(PO_filter, Sheets("Order list").Range("R" & j + 2).Text, 1), 0)
    If Find_Fabric > 0 And Find_PO > 0 Then
    Sheets("Order list").Range("X" & j + 2).Value = Sheets("Fabric contract").Range("O" & i + 2).Value
    Sheets("Order list").Range("Y" & j + 2).Value = Sheets("Fabric contract").Range("W" & i + 2).Value
    End If
    Next j
    Next i
Else: MsgBox "Incorrect Format"
End If
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[ptm0412]

Dùng mảng xem thử bạn nhé. Chạy hết 0,125 giây

Dùng mảng thì nhanh rồi. Nhưng thiếu chuyện kiểm tra tiêu đề dữ liệu, nếu dữ liệu bị chèn/ xoá cột hoặc bị sửa tiêu đề thì trả dữ liệu bắt làm lại.

 

[Maika8008]

Dùng mảng thì nhanh rồi. Nhưng htiếu chuyện kiểm tra tiêu đề dữ liệu, nếu dữ liệu bị chèn/ xoá cột hoặc bị sửa tiêu đề thì trả dữ liệu bắt làm lại.

Cũng góp code cho phong phú tí thôi chứ không định làm 1 sub hoàn chỉnh cho thớt đâu bác ơi.

 

[Dang Le Khanh Ninh]

Camr

Dùng Dic để tăng tốc code

Sub Check()
  Dim sArr(), oArr(), res(), S, S2, T, dic As Object
  Dim sRow&, i&, j&, j2&
 
  Set dic = CreateObject("scripting.dictionary")
  dic.CompareMode = vbTextCompare
  With Sheets("Fabric contract")
    For j = 1 To 23
      If .Cells(1, j) <> .Cells(2, j) Then MsgBox "Incorrect Format": Exit Sub
    Next j
    If .AutoFilterMode = True Then .AutoFilterMode = False
    sArr = .Range("D3", .Range("W" & .Range("D1000000").End(xlUp).Row)).Value
  End With
  With Sheets("Order list")
    For j = 1 To 23
      If .Cells(1, j) <> .Cells(2, j) Then MsgBox "Incorrect Format": Exit Sub
    Next j
    If .AutoFilterMode = True Then .AutoFilterMode = False
    oArr = .Range("K3", .Range("R1000000").End(xlUp)).Value
  End With
 
  sRow = UBound(sArr)
  For i = 1 To sRow
    dic.Item(sArr(i, 1) & "|" & sArr(i, 5)) = Array(sArr(i, 12), sArr(i, 20))
  Next i
  Call TangToc(False)
  sRow = UBound(oArr)
  ReDim res(1 To sRow, 1 To 2)
  For i = 1 To sRow
    S = Split("/" & oArr(i, 8), "/")
    S2 = Split("/" & oArr(i, 1), "/")
    For j = 1 To UBound(S)
      For j2 = 1 To UBound(S2)
        If dic.exists(S(j) & "|" & S2(j2)) Then
          T = dic.Item(S(j) & "|" & S2(j2))
          res(i, 1) = T(0)
          res(i, 2) = T(1)
        End If
      Next j2
    Next j
  Next i
  Sheets("Order list").Range("X3").Resize(sRow, 2) = res
  Call TangToc(True)
  MsgBox "Xong!"
End Sub

Sub TangToc(ByVal bT As Boolean)
  Application.ScreenUpdating = bT
  Application.DisplayAlerts = bT
  Application.AskToUpdateLinks = bT
End Sub

Cảm ơn bạn nhé!

 

[ptm0412]

Cũng góp code cho phong phú tí thôi chứ không định làm 1 sub hoàn chỉnh cho thớt đâu bác ơi.

À, tại tôi cầu toàn và lo xa thôi, giả sử tác giả thấy code nhanh là lấy về dùng, sau vài lần đúng, tới lần chạy khác thấy kết quả 2 cột X, Y đáng lẽ là 2 cột ngày, lại ra 1 cột text gì đó lạ hoắc lại bảo code sai.

 

[Maika8008]

À, tại tôi cầu toàn và lo xa thôi, giả sử tác giả thấy code nhanh là lấy về dùng, sau vài lần đúng, tới lần chạy khác thấy kết quả 2 cột X, Y đáng lẽ là 2 cột ngày, lại ra 1 cột text gì đó lạ hoắc lại bảo code sai.

Tôi nghĩ là nếu cần dùng thì chủ thớt biết rào cái sub này trong vòng If ... End If.

 

[ongke0711]

Thực tình mà nói: do mình dốt ngoại ngữ nên thấy đặt tến biến, tên sub toàn là tiếng Anh thì dị ứng.
Tại sao là Dim PO_filter As String mà không là Dim POloc as String cho dẽ đọc, dễ viết
Hay Dim Compare_SheetsFabric1 As Variant sao không là Dim Rng1 as Variant vừa dễ đọc, dễ viết, viết ngắn hơn....

Xét cho cùng đối với người dùng thì tính hiệu quả (chính xác, nhanh) là cần thiết nhất, chứ không nhất thiết là phải đặt tến biến, tên sub, tên hàm có tý ngoại ngữ cho nó có tính quốc tế mới là đẳng cấp hay gì gì đó.

Tại sao bạn lại đem cái quan điểm chủ quan, thói quen viết code của bạn áp đặt, nhận xét cách viết code của người khác vậy, cách viết code (đặt tên biến thuần Việt) của bạn có phải là chuẩn mực được công nhận không vậy? Người viết code lựa chọn cách viết nào mà họ quen thuộc nhất, dễ nhớ đối với họ nhất để xử lý một bài toán nào đó cho ra kết quả, sau đó mới tinh chỉnh để code được tường minh, rõ ràng cho người kế thừa, bảo trì code có thể hiểu được. Đối với họ, học đọc tài liệu code nước ngoài quen rồi thì thói quen đặt các tên biến cũng theo đó mà hình thành và dùng luôn, rảnh đâu mà đi Việt hoá nó cho ai đó đọc. Nếu nhìn rộng ra nữa thì bạn sẽ thấy rất nhiều dự án được phân bổ cho các nhóm, cty lập trình các nước, mỗi nhóm phụ trách viết môt module nào đó xong sẽ ráp lại thành dự án hoàn chỉnh, do đó tiếng Anh là chuẩn mực trong viết code, giao tiếp code.