On Error Goto Label không thoát lỗi quá 1 lần

holykens · 24/4/21

Chào các bác,

Hiện tại mình đang gặp 1 vấn đề trong code vba nên rất mong được mọi người góp ý.

Mã:

Option Explicit
Dim X As Integer
Dim Rng As String


Sub runtime91()
Sheet1.Select               'Select the first sheet
      
For X = 1 To 43             'Setting the loop
Rng = Sheets("Reference").Cells(153 + X, 8).Value   'assigning variable for cells containing the last registration dates
If Rng = "0" Or Rng = "" Then           'Logical testing for periods with the last registration dates
Else
    On Error GoTo continue
    Cells.Find(What:=Rng, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Select       'Find the last registration dates based on reference datas
    If ActiveCell.Column = 1 Then
    ActiveCell.Offset(0, 9).Value = ActiveCell  'Write the last registration dates
    ElseIf ActiveCell.Column = 9 Then
    ActiveCell.Offset(0, 1).Value = ActiveCell  'Write the last registration dates
    End If
End If
continue:
Next

End Sub

Code phía trên sẽ kiểm tra các cell từ H154 đến H196 của reference tab. Các cell này chứa dữ liệu date dưới dạng string. Nếu như ô nào trống hoặc bằng 0 thì sẽ tiếp tục vòng lặp. Nếu như cell có dữ liệu thì sẽ tìm date tương ứng ở Sheet1 tab.

Vấn đề là code bị Runtime error 91 tại lần thứ 2 không tìm thấy dữ liệu date.
Dòng code lỗi:

Mã:

Cells.Find(What:=Rng, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Select

Dòng code

Mã:

On Error GoTo continue

đã bỏ qua lỗi ở lần không tìm thấy đầu tiên.

Mục đích là sẽ bỏ qua error đến khi vòng lặp kết thúc. Mình thắc mắc tại sao dòng

Mã:

On Error GoTo continue

lại không bỏ qua lỗi lần 2 ?

Phía bên dưới là link dropbox của worksheet đang chứa code bị lỗi.

Mã:

https://www.dropbox.com/scl/fi/cc83cwku0d8kk7le2j7yi/Runtime-error-91.xlsm?dl=0&rlkey=64yovaxo87wlosjgc235j6dlj

Mong mọi người giúp đỡ mình vấn đề này.

Edit: file đã được đính kèm

ptm0412 · 24/4/21

Bạn thử code này:

Mã:

Option Explicit
'_________________'

Sub runtime91()
Sheet1.Select               'Select the first sheet
Dim X As Long
Dim Found As Range, k As Long
For X = 1 To 43             'Setting the loop
    Dim Rng 'As String
    Rng = Sheets("Reference").Cells(153 + X, 8).Value   'assigning variable for cells containing the last registration dates
    If Rng <> "0" And Rng <> "" Then           'Logical testing for periods with the last registration dates
        Set Found = Sheet1.Range("A2:I100000").Find(What:=Rng)       'Find the last registration dates based on reference datas
        If Not Found Is Nothing Then
          k = k + 1
          If Found.Column = 1 Then
            Found.Offset(0, 9).Value = Found.Value  'Write the last registration dates
          ElseIf Found.Column = 9 Then
            Found.Offset(0, 1).Value = Found.Value  'Write the last registration dates
          End If
        End If
    End If
Next
MsgBox k
End Sub

- Biến nếu không dùng nhiều chỗ, nên khai báo trong code, không khai báo ngoài
- Dữ liệu cột A sheet1 dạng ngày tháng nhưng lại định dạng text, trong khi đó cột 8 sheet Reference là ngày tháng, dù không lỗi cũng chẳng bao giờ tìm ra

holykens · 24/4/21

ptm0412 đã viết:

Bạn thử code này:

Mã:

Option Explicit
'_________________'

Sub runtime91()
Sheet1.Select               'Select the first sheet
Dim X As Long
Dim Found As Range, k As Long
For X = 1 To 43             'Setting the loop
    Dim Rng 'As String
    Rng = Sheets("Reference").Cells(153 + X, 8).Value   'assigning variable for cells containing the last registration dates
    If Rng <> "0" And Rng <> "" Then           'Logical testing for periods with the last registration dates
        Set Found = Sheet1.Range("A2:I100000").Find(What:=Rng)       'Find the last registration dates based on reference datas
        If Not Found Is Nothing Then
          k = k + 1
          If Found.Column = 1 Then
            Found.Offset(0, 9).Value = Found.Value  'Write the last registration dates
          ElseIf ActiveCell.Column = 9 Then
            Found.Offset(0, 1).Value = Found.Value  'Write the last registration dates
          End If
        End If
    End If
Next
MsgBox k
End Sub

- Biến nếu không dùng nhiều chỗ, nên khai báo trong code, không khai báo ngoài
- Dữ liệu cột A sheet1 dạng ngày tháng nhưng lại định dạng text, trong khi đó cột 8 sheet Reference là ngày tháng, dù không lỗi cũng chẳng bao giờ tìm ra

Do dữ liệu từ các sheets này được trích xuất từ 2 nguồn dữ liệu khác nhau nên mới có sự không đồng nhất. Nếu như dùng code của bạn thì đúng là cần có thêm 1 bước convert data. Cũng chính là lí do mình dùng find nếu lệch hệ text vẫn tìm ra - mặc dù cách này mình biết nó cũng chứa nhiều rủi ro.
Code của bạn đã cho mình hướng giải quyết vấn đề hiện tại.

Thanks bạn nhiều nha

ptm0412 · 25/4/21

holykens đã viết:
cũng chứa nhiều rủi ro.

Một tỷ rủi ro. Dùng dữ liệu ngày tháng tìm trong dữ liệu text? Dùng ngày tháng "dd/mm/yy" tìm trong "dd/mm/yyyy"? Dùng ngày quy ra số dạng text "12345" tìm trong "dd/mm/yyyy"? Tìm 1 tỷ năm cũng không ra.

batman1 · 25/4/21

1. Trước hết nói về lỗi.
Bình thường VBA có procedure để xử lý lỗi. Khi gặp lỗi thì việc thực hiện code sẽ bị dừng, thông báo về lỗi sẽ được hiển thị. Có thể thay đổi cách xử lý lỗi bằng cách thay thế procedure mặc định bằng On Error ... (Resume Next, GoTo line, GoTo 0).
"Người ta" phân biệt 2 trạng thái của procedure xử lý lỗi. Trạng thái "enabled". Tức được bật nhưng mới chỉ ở tư thế "sẵn sàng" làm nhiệm vụ. Trạng thái "active" là trạng thái khi procedure đang ở trạng thái "enabled" thì sảy ra lỗi khi thực hiện code. Lúc này trạng thái chuyển sang "active", tức là không còn là sẵn sàng làm nhiện vụ nữa mà là "vào cuộc, xử lý". Khi đang ở trạng thái "active" cho tới trước khi ra khỏi trạng thái "active" mà lại sảy ra lỗi thì lúc này việc thực hiện code sẽ bị dừng và lỗi được thông báo. Bởi khi procedure xử lý lỗi đang xử lý lỗi hiện hành dở dang thì nó không thể xử lý lỗi tiếp theo. Muốn xử lý lỗi tiếp theo thì phải ra khỏi trạng thái "active".
Trong trường hợp của bạn không dùng được Resume, Resume Next.

Có một câu lệnh mà tôi chưa thấy ai dùng, bởi chưa ai gặp trường hợp phải xử lý lỗi rất phức tạp.

On Error GoTo -1 sẽ kết thúc việc xử lý lỗi hiện hành và ở tư thế sẵn sàng xử lý lỗi tiếp theo. Tức kết thúc, thực hiện xong việc xử lý lỗi hiện hành và ra khỏi trạng thái "active" và trở về trạng thái "enabled" - trạng thái được "bật" để sẵn sàng làm nhiệm vụ..

Thêm dòng On Error GoTo -1 sau dòng continue: thì sẽ "nhẩy" qua tất cả các lỗi.

2. Dữ liệu và định dạng có vấn đề.
Không lý gì lại Dim Rng As String khi cột H phải là ngày tháng chuẩn. Nhưng cho dù khai báo Dim Rng As Variant thì Rng ở
Rng = Sheets("Reference").Cells(153 + X, 8).Value

cũng vẫn là STRING. Vô lý phải không? Chỉ cần tạo sheet mới -> nhập bằng tay thật chuẩn dữ liệu ngày tháng trong cột Reference!H rồi kiểm tra (với khai báo Dim Rng As Variant) thì sẽ thấy lúc này sẽ có vd. Rng = Empty chứ không phải Rng = "".

3. Cột A và I của Sheet1 không chứa ngày tháng. Chúng chỉ là ngày tháng nhái, giả bộ ngày tháng.

4. Thực ra không ai viết code kiểu như tác giả rồi xử lý lỗi mệt nghỉ.
Thay cho

Mã:

    On Error GoTo continue
    Cells.Find(What:=Rng, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Select       'Find the last registration dates based on reference datas
   
    If ActiveCell.Column = 1 Then
        ActiveCell.Offset(0, 9).Value = ActiveCell  'Write the last registration dates
    ElseIf ActiveCell.Column = 9 Then
        ActiveCell.Offset(0, 1).Value = ActiveCell  'Write the last registration dates
    End If
End If
continue:
Next

thì

Mã:

Dim cell_ As Range
...
Set cell_ = Cells.Find(What:=Rng, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)
    If Not cell_ Is Nothing Then
        If cell_.Column = 1 Then
            cell_.Offset(0, 9).Value = cell_.Value
        ElseIf cell_.Column = 9 Then
            cell_.Offset(0, 1).Value = cell_.Value
        End If
    End If
End If
Next

HieuCD · 25/4/21

holykens đã viết:
Do dữ liệu từ các sheets này được trích xuất từ 2 nguồn dữ liệu khác nhau nên mới có sự không đồng nhất. Nếu như dùng code của bạn thì đúng là cần có thêm 1 bước convert data. Cũng chính là lí do mình dùng find nếu lệch hệ text vẫn tìm ra - mặc dù cách này mình biết nó cũng chứa nhiều rủi ro.
Code của bạn đã cho mình hướng giải quyết vấn đề hiện tại.

Thanks bạn nhiều nha

Chạy code

Mã:

Sub runtime()
  Dim Found As Range, Rng, tmp As String, i As Long, iRow As String, eRow As Long
 
  eRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row 'Dong cuoi Sheet1
  If eRow < 2 Then Exit Sub
  For i = 1 To 43             'Setting the loop
    Rng = Sheets("Reference").Cells(153 + i, 8).Value  'assigning variable for cells containing the last registration dates
    tmp = Format(Rng, "dd/mm/yyyy")
    If TypeName(Rng) = "Date" Then         'Logical testing for periods with the last registration dates
      Set Found = Sheet1.Range("A2:I" & eRow).Find(What:=tmp)     'Find the last registration dates based on reference datas
      If Not Found Is Nothing Then
        iRow = iRow & "," & Found.Row
        If Found.Column = 1 Then
          Found.Offset(0, 9).Value = Found.Value  'Write the last registration dates
        ElseIf Found.Column = 9 Then
          Found.Offset(0, 1).Value = Found.Value  'Write the last registration dates
        End If
      End If
    End If
  Next i
  MsgBox "Dong cap nhat:  " & Mid(iRow, 2, Len(iRow))
End Sub

SA_DQ · 25/4/21

Sau khi đọc hết các bài đăng bên trên mình rút ra 2 vấn đề mà mình cho là rất đáng quan tâm đối với mình; Đó là

PHP:

1  On Error GoTo continue
2   Cells.Find(What:=Rng, After:=Range("A1"), LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Select       'Find the last registration dates based on reference datas

Về dòng lệnh (có số 1): Rất cảm ơn tác giả bài #5 đã đề cập rất kỹ lưỡng về cách xử lý lỗi! Nếu được mình sẽ nhấn nhiều nút cảm ơn cùng 1 lúc;
2. Về câu lệnh (2) của tác giả bài đăng vế phương thức FIND() thì nên tìm lại bài tổng quan về phương thức này & đọc lại hết từ đầu đến cuối các bài viết trong nớ.
Chỉ sau khi nắm vững về FIND() thì cách viết câu lệnh sẽ chỉnh chu hơn!
/(hi đọc nên chú trọng ở 2 điểm

A./ Với FIND() ta nên viết bài bản hơn, đại loại như các bài trên đã chỉ ra:

Mã:

Dim Rng As Range, sRng As Range

Set Rng= Range(GPE).CurrentRegion  'GPE là vùng ô mà ta biết chắc là có dữ liệu)
Set sRng=Rng.Find (. . . )
If sRng Is Nothing Then
     MsgBox "Nothing",, "GPE.COM"
Ekse
    sRng.Select
   MsgBox sRng.Address
End If

B./ Nói thêm:
Khi chúng ta cần tìm 1 dữ liệu kiểu Ngày-Tháng-Năm thì nhất thiết phải:
a./ Chuyển toàn vùng ô Rng sang kiểu "MM/DD/yyyy"
b./ Chuyển Dữ liệu để đem tìm cũng về dạng "MM/DD/yyyy"
(4) Nên đọc thêm phương thức FIND() nếu vùng ô Rng có chứa nhóm ô trộn

batman1 · 25/4/21

SA_DQ đã viết:
Sau khi đọc hết các bài đăng bên trên mình rút ra 2 vấn đề mà mình cho là rất đáng quan tâm đối với mình; Đó là

PHP:

1 On Error GoTo continue

Về dòng lệnh (có số 1):

Mã:

Sub test1()
    On Error GoTo xuly_loi
  
    Debug.Print 1 / 0

thoat:
    Exit Sub
xuly_loi:
    Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description
    Resume thoat
End Sub

Sẽ sảy ra lỗi vì ta cố tình chia cho 0. Lúc đó sẽ có bước nhảy tới dòng Debug.Print ... Code xử lý lỗi chỉ gồm 2 dòng Debug.Print, Resume.

Tuy nhiên nhiều khi code xử lý lỗi có thể phước tạp hơn. Vd.

Mã:

Sub test2()
    On Error GoTo xuly_loi
  
    Debug.Print 1 / 0    ' (A)

thoat:
    Exit Sub
xuly_loi:
    Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description
   
    Debug.Print 1 / 0   ' (B) sảy ra lỗi ngay trong quá trình xử lý lỗi hiện hành. Tức sảy ra lỗi khi đang thực hiện code xử lý lỗi.
   
    Resume thoat
End Sub

Khi sảy ra lỗi ở dòng (A) thì có bước nhày tới dòng Debug.Print sau xuly_loi: bởi ngay đầu có On Error GoTo xuly_loi. Tuy nhiên khi sảy ra lỗi ở (B) thì không có bước nhẩy nào tới Debug.Print nữa mà thông báo về lỗi được hiển thị, tiếp theo việc thực hiện code bị ngắt.

Ta xét code khác

Mã:

Sub test3()
    On Error GoTo xuly_loi
  
    Debug.Print 1 / 0   ' (A)

thoat:
    Exit Sub
xuly_loi:
    Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description
   
    On Error Resume Next    ' (C)
   
    Debug.Print 1 / 0   ' (B) sảy ra lỗi ngay trong quá trình xử lý lỗi hiện hành. Tức sảy ra lỗi khi đang thực hiện code xử lý lỗi.
   
    Resume thoat
End Sub

Những tưởng thêm dòng (C) thì lỗi ở dòng (B) sẽ được bỏ qua, nhưng không phải thế. Vẫn bị lỗi như với test2. Nguyên nhân là On Error Resume Next không có tác dụng khi code xử lý lỗi đang xử lý lỗi. Nói cách khác là khi procedure xử lý lỗi đang active thì OnError Resume Next không có tác dụng.

Nếu thay cho On Error Resume Next mà ta có On Error GoTo thoat thì hậu quả cũng thế. On Error GoTo thoat không có tác dụng khi procedure xử lý lỗi đang active - đang xử lý lỗi hiện hành, chưa kết thúc.

Muốn lỗi sảy ra trong phần code xử lý lỗi, các dòng code bắt đầu từ dòng Debug.Print, được xử lý thì trước khi lỗi đó sảy ra thì phải có sự kết thúc xử lý lỗi hiện hành. On Error GoTo -1 kết thúc việc xử lý lỗi hiện hành, và nó có tác dụng khi procedure xử lý lỗi đang active.

Ta xét code

Mã:

Sub test4()
    On Error GoTo xuly_loi
  
    Debug.Print 1 / 0   ' (A)

thoat:
    Exit Sub
xuly_loi:
    Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description
   
    On Error GoTo -1    ' (D)
    On Error Resume Next    ' (C)

    Debug.Print 1 / 0   ' (B) sảy ra lỗi ngay trong quá trình xử lý lỗi hiện hành. Tức sảy ra lỗi khi đang thực hiện code xử lý lỗi.
   
    MsgBox "Done"
End Sub

Lỗi sảy ra tại dòng (A). Do có On Error GoTo xuly_loi nên có bước nhẩy tới dòng Debug.Print. Dòng (D) kết thúc việc xử lý lỗi hiện hành (lỗi ở dòng (A)), procedure xử lý lỗi không còn active, vì thế dòng (C) có tác dụng, và hậu quả là lỗi ở dòng (B) được bỏ qua, cuối cùng là hiện cửa sổ MsgBox và kết thúc Sub.

Nếu thay cho On Error GoTo -1 mà ta lại có On Error GoTo 0 ở dòng (D) thì On Error Resume Next ở dòng (C) lại không có tác dụng, và lỗi ở (B) lại bị thông báo và code bị ngắt. Bắt buộc phải là On Error GoTo -1.

truongvu317 · 25/4/21

batman1 đã viết:
Mã:

Sub test1() On Error GoTo xuly_loi Debug.Print 1 / 0 thoat: Exit Sub xuly_loi: Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description Resume thoat End Sub

Sẽ sảy ra lỗi vì ta cố tình chia cho 0. Lúc đó sẽ có bước nhảy tới dòng Debug.Print ... Code xử lý lỗi chỉ gồm 2 dòng Debug.Print, Resume.

Tuy nhiên nhiều khi code xử lý lỗi có thể phước tạp hơn. Vd.

Mã:

Sub test2() On Error GoTo xuly_loi Debug.Print 1 / 0 ' (A) thoat: Exit Sub xuly_loi: Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description Debug.Print 1 / 0 ' (B) sảy ra lỗi ngay trong quá trình xử lý lỗi hiện hành. Tức sảy ra lỗi khi đang thực hiện code xử lý lỗi. Resume thoat End Sub

Khi sảy ra lỗi ở dòng (A) thì có bước nhày tới dòng Debug.Print sau xuly_loi: bởi ngay đầu có On Error GoTo xuly_loi. Tuy nhiên khi sảy ra lỗi ở (B) thì không có bước nhẩy nào tới Debug.Print nữa mà thông báo về lỗi được hiển thị, tiếp theo việc thực hiện code bị ngắt.

Ta xét code khác

Mã:

Sub test3() On Error GoTo xuly_loi Debug.Print 1 / 0 ' (A) thoat: Exit Sub xuly_loi: Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description On Error Resume Next ' (C) Debug.Print 1 / 0 ' (B) sảy ra lỗi ngay trong quá trình xử lý lỗi hiện hành. Tức sảy ra lỗi khi đang thực hiện code xử lý lỗi. Resume thoat End Sub

Những tưởng thêm dòng (C) thì lỗi ở dòng (B) sẽ được bỏ qua, nhưng không phải thế. Vẫn bị lỗi như với test2. Nguyên nhân là On Error Resume Next không có tác dụng khi code xử lý lỗi đang xử lý lỗi. Nói cách khác là khi procedure xử lý lỗi đang active thì OnError Resume Next không có tác dụng.

Nếu thay cho On Error Resume Next mà ta có On Error GoTo thoat thì hậu quả cũng thế. On Error GoTo thoat không có tác dụng khi procedure xử lý lỗi đang active - đang xử lý lỗi hiện hành, chưa kết thúc.

Muốn lỗi sảy ra trong phần code xử lý lỗi, các dòng code bắt đầu từ dòng Debug.Print, được xử lý thì trước khi lỗi đó sảy ra thì phải có sự kết thúc xử lý lỗi hiện hành. On Error GoTo -1 kết thúc việc xử lý lỗi hiện hành, và nó có tác dụng khi procedure xử lý lỗi đang active.

Ta xét code

Mã:

Sub test4() On Error GoTo xuly_loi Debug.Print 1 / 0 ' (A) thoat: Exit Sub xuly_loi: Debug.Print "[Error: " & Err.Number & "]" & vbTab & Err.Description On Error GoTo -1 ' (D) On Error Resume Next ' (C) Debug.Print 1 / 0 ' (B) sảy ra lỗi ngay trong quá trình xử lý lỗi hiện hành. Tức sảy ra lỗi khi đang thực hiện code xử lý lỗi. MsgBox "Done" End Sub

Lỗi sảy ra tại dòng (A). Do có On Error GoTo xuly_loi nên có bước nhẩy tới dòng Debug.Print. Dòng (D) kết thúc việc xử lý lỗi hiện hành (lỗi ở dòng (A)), procedure xử lý lỗi không còn active, vì thế dòng (C) có tác dụng, và hậu quả là lỗi ở dòng (B) được bỏ qua, cuối cùng là hiện cửa sổ MsgBox và kết thúc Sub.

Nếu thay cho On Error GoTo -1 mà ta lại có On Error GoTo 0 ở dòng (D) thì On Error Resume Next ở dòng (C) lại không có tác dụng, và lỗi ở (B) lại bị thông báo và code bị ngắt. Bắt buộc phải là On Error GoTo -1.

Hihi, cảm ơn bác Rơi đã chia sẻ, giờ cháu mới biết cái này, làm thì chắc chưa làm được

huuthang_bd · 26/4/21

batman1 đã viết:
Bắt buộc phải là On Error GoTo -1

Thay bằng 2 dòng này được không anh

Mã:

Resume ResetErrHandling1
ResetErrHandling1:

batman1 · 26/4/21

huuthang_bd đã viết:
Thay bằng 2 dòng này được không anh

Mã:

Resume ResetErrHandling1 ResetErrHandling1:

Ý là không dùng được On Error GoTo 0 mà phải là On Error GoTo -1.

Còn để kết thúc việc xử lý lỗi thì ngoài On Error GoTo -1 còn có
Exit <procedure>
Resume
Resume Next
Resume <label>

On Error Goto Label không thoát lỗi quá 1 lần

holykens

Thành viên mới

File đính kèm

ptm0412

Bad Excel Member

holykens

Thành viên mới

ptm0412

Bad Excel Member

batman1

Thành viên gạo cội

HieuCD

Chuyên gia GPE

SA_DQ

/(hông là gì!

batman1

Thành viên gạo cội

truongvu317

Thành viên tích cực

huuthang_bd

Chuyên gia GPE

batman1

Thành viên gạo cội

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

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