มีปัญหากับการใช้งาน on error goto ใน VBA ครับ

[newplayers]

ผมมีปัญหากับการใช้ on error goto ร่วมกับ การใช้ For ..... Next ครับ
คือผมต้องการเขียนโค้ดให้หาคำที่กำหนดขึ้นใน sheet1 ไปหาใน sheet2 เพื่อเอา value มากรอกใน sheet1

ตัวอย่าง
ผมมีคำอยู่ใน sheet1 ที่ตำแหน่ง A1:A8
ผมต้องการใช้คำที่ตำแหน่ง A1 ไปค้นหาใน Sheet2 ที่ collumn A หากพบให้ นำค่าใน collumn B ไปกรอกใน sheet1 ที่ตำแหน่ง B1 หากไม่พบให้ข้ามไป หาที่ A2 ต่อ ใช้ค้นหาต่อไปเรื่อยๆจนถึง A8

ผมได้ทดลองเขียนโค้ดขึ้นมา พบว่าเมื่อเจอ error ครั้งที่ 2 VBA จะไม่ run ต่อ แล้วจะขึ้นว่า Run-time error '91': object variable or with block variable not set

โดยไฟล์ตัวอย่างจะขึ้น Debug ในการ loop รอบที่3 (i = 3)
และ Debug ขึ้นที่บรรทัต Selection.Find(What:=val).Select ครับ

พยายามสับบรรทัตหลายทีแล้วก็ยังติดปัญหาเดิมครับ รบกวนพี่ๆ ช่วยทีครับ

Code: Select all

Public Sub find_value()

Dim end_row As Long

Sheets("Sheet1").Select
Range("a1").Select

end_row = ActiveCell.End(xlDown).Row
       
Dim val As String
Dim i As Long

    For i = 1 To end_row
        val = Range("a" & i).Value
        Sheets("Sheet2").Select
        Columns("a:a").Select
        On Error GoTo skipfind:
            Selection.Find(What:=val).Select
        On Error GoTo 0
        ActiveCell.Offset(0, 1).Copy
        Sheets("Sheet1").Select
        Range("B" & i).Select
        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
           
skipfind:       Sheets("Sheet1").Select
        
    Next
    
End Sub

ไฟล์ตัวอย่างครับ

problem with on error goto.xlsm

ไฟล์

(15.29 KiB) Downloaded 9 times

[puriwutpokin]

ปรับเป็น

Code: Select all

Public Sub find_value()
Dim end_row As Long
Sheets("Sheet1").Select
Range("a1").Select
end_row = ActiveCell.End(xlDown).Row
Dim val As String
Dim i As Long
    For i = 1 To end_row
        val = Range("a" & i).Value
        Sheets("Sheet2").Select
        Columns("a:a").Select
        On Error GoTo skipfind:
            Cells.Find(What:=val).Select
        On Error GoTo 0
        ActiveCell.Offset(0, 1).Copy
        Sheets("Sheet1").Select
        Range("B" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues
skipfind: Sheets("Sheet1").Select
    Next
End Sub

[newplayers]

ปรับเป็น

Code: Select all

Public Sub find_value()
Dim end_row As Long
Sheets("Sheet1").Select
Range("a1").Select
end_row = ActiveCell.End(xlDown).Row
Dim val As String
Dim i As Long
    For i = 1 To end_row
        val = Range("a" & i).Value
        Sheets("Sheet2").Select
        Columns("a:a").Select
        On Error GoTo skipfind:
            Cells.Find(What:=val).Select
        On Error GoTo 0
        ActiveCell.Offset(0, 1).Copy
        Sheets("Sheet1").Select
        Range("B" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues
skipfind: Sheets("Sheet1").Select
    Next
End Sub

ขอบคุณมากๆครับ
แต่ผมยังติดอยู่นิดหนึ่งครับ ผมลอง Toggle เพื่อดูดีละบรรทัดว่า Code สั่งให้ Excel ทำอะไรบ้าง
พบว่า Logic มันผิดอ่ะครับ ผมอยากให้ เมื่อหาคำไม่เจอ ให้ข้ามไปหาคำถัดไป แต่ใน Code มันสั่งให้ก็อบช่องว่างมาวางต่อท้ายคำที่หาไม่เจอแทนอ่ะครับ ซึ่งงานที่ผมทำจริงๆ เมื่อหาไม่เจอจะไม่ได้เป็นช่องว่างตามตัวอย่าง อาจจะทำให้มันเพี้ยนได้

รบกวนพี่ๆช่วยผมดูอีกรอบทีครับ ขอบคุณล่วงหน้าครับ

[puriwutpokin]

ลองปรับมาใช้โค้ดอีกแบบดูครับ

Code: Select all

Sub CopyData()
Dim cell As Range
Dim rw As Long
For Each cell In Worksheets("Sheet1").Range("A:A").Cells
If cell <> "" Then
rw = Lookup(cell.Value)
If rw <> 0 Then
Worksheets("Sheet1").Cells(cell.Row, "A").Resize(, 2).Value = _
Worksheets("Sheet2").Cells(rw, "A").Resize(, 2).Value
End If
End If
Next
End Sub
Function Lookup(item As String) As Long
On Error Resume Next
Lookup = WorksheetFunction.Match(item, Worksheets("Sheet2").Range("A:A"), False)
On Error GoTo 0
End Function

[newplayers]

ลองปรับมาใช้โค้ดอีกแบบดูครับ

Code: Select all

Sub CopyData()
Dim cell As Range
Dim rw As Long
For Each cell In Worksheets("Sheet1").Range("A:A").Cells
If cell <> "" Then
rw = Lookup(cell.Value)
If rw <> 0 Then
Worksheets("Sheet1").Cells(cell.Row, "A").Resize(, 2).Value = _
Worksheets("Sheet2").Cells(rw, "A").Resize(, 2).Value
End If
End If
Next
End Sub
Function Lookup(item As String) As Long
On Error Resume Next
Lookup = WorksheetFunction.Match(item, Worksheets("Sheet2").Range("A:A"), False)
On Error GoTo 0
End Function

ขอบคุณมากๆครับ ตรงตามความต้องการทุกอย่างครับ