Sữa lổi File chay chậm và chạy không ngừng

ZzNHCzZ · 1/8/08

Em chào các anh chị GPE!
Hix.. Em có 1 File Macro bị tình trạng sau:

File chậy rất chậm. 20 phút cho 20 dòng dữ liệu
Nếu dử liệu chỉ có 1 dòng thì nó chạy không ngừng luôn.
- vd: Các sheet chỉ có EK0708000001 thì nó chạy hoài luôn

Rất mong các sư phụ giải cứu em. Vì File này mà công việc của em bị hoãn lại.
Em chân thành cám ơn!

-----------------------
Em phát hiện đoạn code này là nguyên nhân gây ra chạy không ngừng khi dữ liệu chỉ có 1 dòng.

For jR = 2 To ErTKT ' Ve
If TKT.Range("B" & jR).Value = RCPNO Then
kRj = kRj + 1
.Range("A" & kRj).Value = TKT.Range("E" & jR).Value
.Range("D" & kRj & ":I" & kRj).Value = TKT.Range("Q" & jR & ":V" & jR).Value

End If

Next jR

Em gửi lại file ngắn gọn hơn để mọi người dể nhìn.
Mong nhận hồi âm từ các anh chị

Thân!

SA_DQ · 1/8/08

Nội chuyện sửa lại cho dễ nhìn cũng mất 1 giờ rồi!

Và kết quả đưa ra đây cũng không xong luôn; Được báo rằng trên vạn từ, mà chỉ Code không thôi đó!

PHP:

    Else 'Neu co data'
    
        RPT.Select
        
1        With RPT 
            .Range("A" & kR & ":M1000").Clear
            .Range("L3:M3").ClearContents
        
            For iR = 2 To ErRCP
                RCPNO = RCP.Range("B" & iR).Value
            
                .Range("A" & kR).Value = RCPNO
                .Range("B" & kR).Value = RCP.Range("I" & iR).Value
                .Range("C" & kR).Value = RCP.Range("D" & iR).Value
                .Range("K" & kR).Value = RCP.Range("L" & iR).Value
            
                kRj = kR
                    For jR = 2 To ErTKT ' Ve
                        If TKT.Range("B" & jR).Value = RCPNO Then
                            kRj = kRj + 1
                            .Range("A" & kRj).Value = TKT.Range("E" & jR).Value
                            .Range("D" & kRj & ":I" & kRj).Value = TKT.Range("Q" & jR & ":V" & jR).Value
      
                        End If
                
                    Next jR
                        
                        kRh = kRj
                        For hR = 2 To ErHTL ' HTL
                            If HTL.Range("B" & hR).Value = RCPNO Then
                                kRh = kRh + 1
                                RPT.Range("A" & kRh).Value = HTL.Range("C" & hR).Value
                                RPT.Range("D" & kRh & ":E" & kRh).Value = HTL.Range("F" & hR & ":G" & hR).Value
        
                            End If
                        Next hR
        
                   FopDiff = ""
                   For jfR = 2 To ErFOP ' Hinh thuc thanh toan
                        If FOP.Range("C" & jfR).Value = RCPNO Then
                            If FOP.Range("D" & jfR).Value = "CSH" Then
                               If FOP.Range("E" & jfR).Value = "USD" Then
                                 
                                  .Range("L" & kR).Value = FOP.Range("Z" & jfR).Value
                               Else
                                  If FOP.Range("E" & jfR).Value = "VND" Then
                                     .Range("M" & kR).Value = FOP.Range("Z" & jfR).Value
                                  Else
                                     If FopDiff <> "" Then FopDiff = FopDiff + ";  "
                                     FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _
                                                & Format(FOP.Range("Z" & jfR).Value, "* #,##0.00")
                                                
                                  End If
                                End If
                            Else '# CSH
                                If FopDiff <> "" Then FopDiff = FopDiff + ";  "
                                FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _
                                          & Format(FOP.Range("f" & jfR).Value, "* #,##0.00")
                            End If
                        End If
                    Next jfR
                        If FopDiff <> "" Then .Range("J" & kR + 1).Value = FopDiff
                            .Range("A" & kR & ":M" & kR).Font.Bold = True
                            .Range("A" & kR & ":M" & kR).Font.Color = vbBlue
                            .Range("D" & kR & ":M" & kR).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                            .Range("A" & kR & ":M" & kRh).Select: Call DrawBor
        
                        If kRh > kR Then
3                            With .Range("D" & kR & ":I" & kR)
                                .FormulaR1C1 = "=SUM(R[1]C:R[" & (kRh - kR) & "]C)"
                                .Value = .Value
4                            End With
                            .Range("J" & kR).FormulaR1C1 = "=RC[-6]+RC[-5]+RC[-4]-RC[-3]"
                            .Range("J" & kR).Value = .Range("J" & kR).Value
                            .Range("K" & kR).Value = .Range("K" & kR).Value
                            .Range("A" & kR + 1 & ":A" & kRh).HorizontalAlignment = xlRight
                            .Range("D" & kR + 1 & ":I" & kRh).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                            .Range("M" & kR + 1 & ":J" & kRh).Select: Call DrawBor2
                        End If
                    kR = kRh + 1
            Next iR
5            With .Range("L3:M3")
                .FormulaR1C1 = "=SUM(R[2]C:R[" & (kRj - 3) & "]C)"
                .Value = .Value
                .NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
6            End With
                .Range("A5").Select
2        End With
        
        
    'Xu ly phan duoi'

Đây là 1 phần trích ra để góp cho bạn 2 ý nhỏ:
a*/ Dòng lệnh mà mình đánh số 1: With RPT
cho đến dòng lệnh được đánh dấu (2) còn 1 số dòng lệnh, như dưới đây là chưa tiết kiệm tài nguyên:

Mã:

                          RPT.Range("A" & kRh).Value = HTL.Range("C" & hR).Value
                                RPT.Range("D" & kRh & ":E" & kRh).Value = HTL.Range("F" & hR & ":G" & hR).Value

b*/ đã cho thụt các dòng lệnh cho dễ nhìn, nhưng hoàn toàn chưa được trật tự cho lắm. Với như vậy, đến bạn lúc cần kiểm tra, tìm sai sót cũng khổ, chứ đừng nói về lỗi logic

voda · 1/8/08

Theo mình, vấn đề của bạn nằm ở các dòng lệnh sau:

Mã:

    ErRCP = RCP.Range("B2").End(xlDown).Row
    ErTKT = TKT.Range("B2").End(xlDown).Row
    ErFOP = FOP.Range("C2").End(xlDown).Row
    ErHTL = HTL.Range("B2").End(xlDown).Row
    ErADM = ADM.Range("A1000").End(xlUp).Row

-Khi các sheet chỉ có EK0708000001 (nghĩa là chỉ có dữ liệu ở dòng 2), các biến ErRCP,ErTKT,ErFOP, ErHTL sẽ nhận giá trị tối đa 65536. Các vòng lặp sẽ chạy gần như vô hạn. Điều đó gây ra tình trạng chương trình chạy không ngừng.
-Khi dữ liệu có nhiều dòng thì biến ErHTL cũng nhận giá trị 65536 làm cho chương trình chậm.(Vì sheet HTL chỉ có dữ liệu ở dòng 1)
Bạn chỉnh lại như sau, rồi test lại xem thử:

Mã:

     ErRCP = RCP.Range("B65000").End(xlUp).Row
    ErTKT = TKT.Range("B65000").End(xlUp).Row
    ErFOP = FOP.Range("C65000").End(xlUp).Row
    ErHTL = HTL.Range("B65000").End(xlUp).Row
    ErADM = ADM.Range("A65000").End(xlUp).Row

ZzNHCzZ · 2/8/08

-Khi các sheet chỉ có EK0708000001 (nghĩa là chỉ có dữ liệu ở dòng 2), các biến ErRCP,ErTKT,ErFOP, ErHTL sẽ nhận giá trị tối đa 65536. Các vòng lặp sẽ chạy gần như vô hạn. Điều đó gây ra tình trạng chương trình chạy không ngừng.
-Khi dữ liệu có nhiều dòng thì biến ErHTL cũng nhận giá trị 65536 làm cho chương trình chậm.(Vì sheet HTL chỉ có dữ liệu ở dòng 1)
Bạn chỉnh lại như sau, rồi test lại xem thử:

Em đã thử với yếu cầu của anh, nhưng macro vẫn chạy chậm lắm anh àh.
Có cách nào khác không anh?
Cám ơn anh nhiều

Thân!

voda · 2/8/08

-Mình đã chỉnh và kiểm tra. Code chạy rất nhanh ( < 1 giây). Bạn tải file về chạy thử.

ZzNHCzZ · 2/8/08

-Mình đã chỉnh và kiểm tra. Code chạy rất nhanh ( < 1 giây). Bạn tải file về chạy thử.

Cám ơn anh! File em chạy nhanh hơn rồi. Sao em làm giống anh mà ko chạy kỳ vây? Đành Copy luôn.

Anh xem giúp em trường hợp sau với nhé
Tại L5 và M5 :Hình thức thanh toán
Em muốn sửa đoạn Code này như sau: Cùng số RCPNO và thanh toán bằng CSH tiền VND thì cộng lại. (tương tự cho USD)

For jfR = 2 To ErFOP ' Hinh thuc thanh toan
If FOP.Range("C" & jfR).Value = RCPNO Then
If FOP.Range("D" & jfR).Value = "CSH" Then
If FOP.Range("E" & jfR).Value = "USD" Then

.Range("L" & kR).Value = FOP.Range("Z" & jfR).Value
Else
If FOP.Range("E" & jfR).Value = "VND" Then
.Range("M" & kR).Value = FOP.Range("Z" & jfR).Value
Else
If FopDiff <> "" Then FopDiff = FopDiff + "; "
FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _
& Format(FOP.Range("Z" & jfR).Value, "* #,##0.00")

End If
End If
Else '# CSH
If FopDiff <> "" Then FopDiff = FopDiff + "; "
FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _
& Format(FOP.Range("f" & jfR).Value, "* #,##0.00")
End If
End If
Next jfR

Hiện tại thì em mới làm được như sau: Cùng số RCPNO và thanh toán bằng CSH tiền VND thì lấy ra. Chứ không biết làm sao cho nó cộng lại. Mong được sự giúp đở của mọi người.

Thân!

ZzNHCzZ · 2/8/08

Theo tôi bạn ZzNHCzZ nên cắt code thành nhiều phân đọan, nhìn thấy "khủng" quá. Công nhận bạn mau tiến bộ quá.

Em đã copy đoạn copy liên quan rồi mừ.
Em vẫn cùi bắp lắm ạ, còn phải nhờ anh chị chỉ bảo nhiều. %#^#$

For jfR = 2 To ErFOP ' Hinh thuc thanh toan
If FOP.Range("C" & jfR).Value = RCPNO Then
If FOP.Range("D" & jfR).Value = "CSH" Then
If FOP.Range("E" & jfR).Value = "USD" Then

.Range("L" & kR).Value = FOP.Range("Z" & jfR).Value
Else
If FOP.Range("E" & jfR).Value = "VND" Then
.Range("M" & kR).Value = FOP.Range("Z" & jfR).Value
Else
If FopDiff <> "" Then FopDiff = FopDiff + "; "
FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _
& Format(FOP.Range("Z" & jfR).Value, "* #,##0.00")

End If
End If
Else '# CSH
If FopDiff <> "" Then FopDiff = FopDiff + "; "
FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _
& Format(FOP.Range("f" & jfR).Value, "* #,##0.00")
End If
End If
Next jfR

Thân!

voda · 2/8/08

Bạn chỉnh lại code như sau:

Mã:

For jfR = 2 To ErFOP ' Hinh thuc thanh toan
         If FOP.Range("C" & jfR).Value = RCPNO Then
                If FOP.Range("D" & jfR).Value = "CSH" Then
                        If FOP.Range("E" & jfR).Value = "USD" Then
            .Range("L" & kR).Value = .Range("L" & kR).Value + FOP.Range("Z" & jfR).Value
                        Else
                        If FOP.Range("E" & jfR).Value = "VND" Then
           .Range("M" & kR).Value = .Range("M" & kR).Value + FOP.Range("Z" & jfR).Value
                       Else
                       If FopDiff <> "" Then FopDiff = FopDiff + ";  "
  FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _ 
& Format(FOP.Range("Z" & jfR).Value, "* #,##0.00")
                                                
                        End If
                  End If
                  Else '# CSH
                   If FopDiff <> "" Then FopDiff = FopDiff + ";  "
 FopDiff = FopDiff & FOP.Range("D" & jfR).Value & " " & FOP.Range("E" & jfR).Value & " " _ 
& Format(FOP.Range("f" & jfR).Value, "* #,##0.00")
            End If
      End If
 Next jfR

ZzNHCzZ · 4/8/08

Lời cuối!

Em xin chần thành cám ơn tất cả mọi người, đã giúp em chỉnh file hoàn thiện hơn.
Em sẽ cố học hỏi thêm nhiều.
Chúc anh chị luôn vui vẽ.

Thân!

Sữa lổi File chay chậm và chạy không ngừng

ZzNHCzZ

Thành viên bị đình chỉ hoạt động

SA_DQ

/(hông là gì!

voda

Thành viên tiêu biểu

ZzNHCzZ

Thành viên bị đình chỉ hoạt động

voda

Thành viên tiêu biểu

File đính kèm

ZzNHCzZ

Thành viên bị đình chỉ hoạt động

ZzNHCzZ

Thành viên bị đình chỉ hoạt động

voda

Thành viên tiêu biểu

ZzNHCzZ

Thành viên bị đình chỉ hoạt động

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

Facebook

Group

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