on goto error ไม่ทำงาน

[sutham]

ผมได้ทำการตรวจสอบเงื่อนไข 2 เงื่อนไข โดยใช้คำสั่ง Do while .... loop ซึ่งเมื่อเกิด error ก็จะใช้คำสั่ง on error goto ..... ซึ่งเมื่อ เกิด error ทั้ง 2 ครั้ง คำสั่ง on error ครั้งที่ 2 ไม่ทำงาน (On Error GoTo ErrorHandler2:) ซึ่งผมไม่แน่ใจว่า code ผมจะผิดหรือไม่ รบกวนช่วยดูให้ผมด้วยครับ

Code: Select all

Sub สี่เหลี่ยมมุมมน1_Click()
On Error GoTo ErrorHandler:
Do While Worksheets("sheet2").Columns("a:a").Find(Range("b2"), LookIn:=xlValues).Row
        msg = MsgBox("มีอักษรตัวนี้แล้วแล้ว" & vbCrLf & "โปรแกรมไม่สามารถบันทึกข้อมูลซ้ำได้", vbOKOnly)
        msg = MsgBox("โปรดตรวจสอบ...." & vbCrLf & " ตัวอักษร", vbOKOnly, "แจ้งตรวจสอบ...")
    Range("b2").Select
    Exit Sub
    Loop
ErrorHandler:
    On Error GoTo ErrorHandler2:
    Do While Worksheets("sheet2").Columns("b:b").Find(Range("c2"), LookIn:=xlValues).Row
msg = MsgBox("ชั้นซ้ำ" & vbCrLf & "โปรดตรวจสอบหรือแก้ไข", vbOKOnly, "แจ้งชั้นซ้ำ...")
 Range("c2").Select
  Exit Sub
    Loop
ErrorHandler2:
 Range("b2:c2").Select
    Selection.Copy
    Sheets("sheet2").Select
    Range("a" & Range("d6").Value).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("sheet1").Select
    Range("b2").Select
End Sub

[snasui]

ลองปรับใช้จากโพสต์นี้ viewtopic.php?t=6241 ครับ

[sutham]

ได้คำแนะนำจากอาจารย์ ตอนนี้ผมปรับโค้ดได้แล้วครับ
ขอบคุณครับ

Code: Select all

Dim i As Integer
Dim c As Range
On Error GoTo ErrorHandler:
    With Sheets("sheet2").Columns("A:A")
        Set c = .Find(Range("b2"), LookIn:=xlValues, LookAt:=xlWhole)
       ' If Range("d4") = "" Then Exit Sub
        If c Is Nothing Then
                         If Worksheets("sheet2").Columns("b:b").Find(Range("c2"), LookIn:=xlValues).Row Then
                             msg = MsgBox("ชั้นซ้ำ" & vbCrLf & "โปรดตรวจสอบหรือแก้ไข", vbOKOnly, "แจ้งชั้นซ้ำ...")
                            Range("c2").Select
                             Exit Sub
                                End If
        Else
            i = .Find(c, LookIn:=xlValues, LookAt:=xlWhole).Row
            MsgBox "อักษรซ้ำ"
        Exit Sub
        End If
    End With
    
ErrorHandler:
 Range("b2:c2").Select
    Selection.Copy
    Sheets("sheet2").Select
    Range("a" & Range("d1").Value).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("sheet1").Select
    Range("b2").Select
End Sub