สอบถาม VLookup ข้าม Workbook ครับ

[Leng]

รบกวนอาจารย์หน่อยครับพอดีผมต้องการ VLookup ข้าม workbook โดย ให้ ไฟล์ fainal-copy ดึงข้อมูลจาก Datax มาครับ

Code: Select all

Private Sub TextBox5_AfterUpdate()
    If Me.TextBox5.Text = "" Then Exit Sub
    If WorksheetFunction.CountIf(Sheets("Data").Range("A:A"), Me.TextBox5.Value) = 0 Then
        'Me.TextBox5.Value = ""
        MsgBox "Not found."
        Exit Sub
    End If
    emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1
    
    With Me
        .TextBox6 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox5), Sheets("Data").Range("lookupdata"), 2, 0)
        .TextBox7 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox5), Sheets("Data").Range("lookupdata"), 3, 0)
        .TextBox8 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox5), Sheets("Data").Range("lookupdata"), 4, 0)
    End With
    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = TextBox4.Value
        .Cells(emptyrow, 4).Value = ComboBox1.Value
        .Cells(emptyrow, 5).Value = TextBox5.Value
        .Cells(emptyrow, 6).Value = TextBox6.Value
        .Cells(emptyrow, 7).Value = TextBox7.Value
        .Cells(emptyrow, 8).Value = TextBox8.Value
        .Cells(emptyrow, 9).Value = TextBox9.Value
    End With
End Sub

[snasui]

กำหนดตัวแปรให้กับช่วงข้อมูลของข้อมูลต้นแหล่งที่จะนำมาใช้ใน Vlookup ตัวอย่างเช่น

Code: Select all

dim rngVlp as range
with workbooks("DataX.xlsx").worksheets(1)
   set rngVlp = .range("a2",.range("z" & .rows.count).end(xlup))
end with
me.textbox1.text = application.vlookup(clng(me.textbox5.text),rngVlp,2,0)

ลองเทียบเคียงและปรับ Code ดูก่อน ติดตรงไหนค่อยถามกันต่อครับ

[Leng]

ติดตรง With Workbooks ครับ ไม่สามารถrun ได้

Code: Select all

Private Sub TextBox5_AfterUpdate()
Dim rngVlp As Range
With Workbooks("C:\Users\Administrator\Desktop\Test\DataX.xlsx").worksheets(sheet1)
Set rngVlp = .Range("A", .Range("D" & .Rows.Count).End(xlUp))
          'Me.TextBox5.Value = ""
MsgBox "Not found."
        Exit Sub

emptyrow = WorksheetFunction.CountA(Range("A:A")) + 1
End With
Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)

    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = TextBox4.Value
        .Cells(emptyrow, 4).Value = ComboBox1.Value
        .Cells(emptyrow, 5).Value = TextBox5.Value
        .Cells(emptyrow, 6).Value = TextBox6.Value
        .Cells(emptyrow, 7).Value = TextBox7.Value
        .Cells(emptyrow, 8).Value = TextBox8.Value
        .Cells(emptyrow, 9).Value = TextBox9.Value
    End With
End Sub

[logic]

เปิด DataX.xlsx ขึ้นมาก่อน พอเปิดแล้วก็เขียน with แบบที่อาจารย์แนะนำ

.worksheets(sheet1) ต้องครอบฟันหนูที่ sheet1 ครับ

[Leng]

Code: Select all

Private Sub TextBox5_AfterUpdate()
Dim rngVlp As Range
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
Set rngVlp = .Range("A1", .Range("D1048576" & .Rows.Count).End(xlUp))
End With
Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)

    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = TextBox4.Value
        .Cells(emptyrow, 4).Value = ComboBox1.Value
        .Cells(emptyrow, 5).Value = TextBox5.Value
        .Cells(emptyrow, 6).Value = TextBox6.Value
        .Cells(emptyrow, 7).Value = TextBox7.Value
        .Cells(emptyrow, 8).Value = TextBox8.Value
        .Cells(emptyrow, 9).Value = TextBox9.Value
    End With
End Sub

จากที่ได้ลองทำตามครับ ขึ้น Error ตรง With Workbooks("DataX.xlsx").Worksheets("Sheet1") ครับ

[snasui]

ผมทดสอบแล้วไม่พบว่าติดปัญหาครับ

[Leng]

รบกวนอาจารย์ช่วยดูหน่อยครับพอผมใช้ปืน scan และทำตามที่อาจารย์บอกก็ยังไม่สามรถ run ได้ครับ

Code: Select all

Private Sub TextBox5_AfterUpdate()
Dim rngVlp As Range
With Workbooks("C:\Users\Administrator\Desktop\Test\DataX.xlsx").Worksheets("Sheet1")
Set rngVlp = .Range("A2", .Range("D1048576" & .Rows.Count).End(xlUp))
End With
Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)

    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = TextBox4.Value
        .Cells(emptyrow, 4).Value = ComboBox1.Value
        .Cells(emptyrow, 5).Value = TextBox5.Value
        .Cells(emptyrow, 6).Value = TextBox6.Value
        .Cells(emptyrow, 7).Value = TextBox7.Value
        .Cells(emptyrow, 8).Value = TextBox8.Value
        .Cells(emptyrow, 9).Value = TextBox9.Value
    End With
End Sub
Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox5.Value <> "" Then
        Cancel = True
        TextBox5.Text = ""
    End If
End Sub

[snasui]

เปลี่ยน With Workbooks("C:\Users\Administrator\Desktop\Test\DataX.xlsx").Worksheets("Sheet1") เป็น

With Workbooks("DataX.xlsx").Worksheets("Sheet1") และต้องเปิดไฟล์ DataX.xlsx ขึ้นมาก่อน

rngVlp ก็ต้อง Set หรือกำหนดค่า ให้เป็นช่วงข้อมูล มีลักษณะเป็นตารางไม่ใช่คอลัมน์เดี่ยว ดูตัวอย่างที่ผมตอบไปครับ

เปลี่ยนแล้วติดตรงไหนค่อยนำมาถามกัน จะได้ตอบต่อไปจากนั้นครับ

[Leng]

อาจารย์ครับผมเปิดไฟล์ DataX ขึ้นมาแล้วแล้วก็ได้แก้โค๊ดแล้ว แต่ก็ยังไม่สามารถ run ได้ยู่ดี แครับ

ขึ้นerror ตรง

Code: Select all

With Workbooks("DataX.xlsx").Worksheets("Sheet1")

Code: Select all

Private Sub TextBox5_AfterUpdate()
Dim rngVlp As Range
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
Set rngVlp = .Range("a2", .Range("z" & .Rows.Count).End(xlUp))
End With
Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)

    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = TextBox4.Value
        .Cells(emptyrow, 4).Value = ComboBox1.Value
        .Cells(emptyrow, 5).Value = TextBox5.Value
        .Cells(emptyrow, 6).Value = TextBox6.Value
        .Cells(emptyrow, 7).Value = TextBox7.Value
        .Cells(emptyrow, 8).Value = TextBox8.Value
        .Cells(emptyrow, 9).Value = TextBox9.Value
    End With
End Sub
Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox5.Value <> "" Then
        Cancel = True
        TextBox5.Text = ""
    End If
End Sub

[snasui]

แนบไฟล์ล่าสุดทั้งหมดมาด้วยจะได้ช่วยดูให้ได้ครับ

[Leng]

ไฟล์ครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

'Other code...
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
    Set rngVlp = .Range("a2", .Range("d" & .Rows.Count).End(xlUp))
    Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
    Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
    Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)
End With
With ThisWorkbook.Worksheets("IN")
    emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
'Other code...

[Leng]

ตอนนี้สามารถดึงข้อมูลจาก ไฟล์ DataX ได้ละครับแต่
ติดปัญาคือ
-ไม่สามารถ run ต่อๆกันได้ครับ
- ผมอยากให้ขึ้นถ้าไม่มีข้อมูลว่า "Not found"

Code: Select all

Private Sub TextBox5_AfterUpdate()
Dim rngVlp As Range
With Workbooks("DataX.xlsx").Worksheets("Sheet1")
Set rngVlp = .Range("a2", .Range("d" & .Rows.Count).End(xlUp))
If Me.TextBox5.Text = "" Then Exit Sub
If WorksheetFunction.CountIf(Workbooks("DataX.xlsx").Worksheets("Sheet1").Range("A:D"), Me.TextBox5.Value) = 0 Then
'Me.TextBox5.Value = ""
MsgBox "Not found."
Exit Sub
End If
    Me.TextBox6.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 2, 0)
    Me.TextBox7.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 3, 0)
    Me.TextBox8.Text = Application.VLookup(CLng(Me.TextBox5.Text), rngVlp, 4, 0)
End With
With ThisWorkbook.Worksheets("IN")
    emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row
   End With
    With Worksheets("IN")
        .Cells(emptyrow, 1).Value = TextBox1.Value
        .Cells(emptyrow, 2).Value = TextBox2.Value
        .Cells(emptyrow, 3).Value = TextBox4.Value
        .Cells(emptyrow, 4).Value = ComboBox1.Value
        .Cells(emptyrow, 5).Value = TextBox5.Value
        .Cells(emptyrow, 6).Value = TextBox6.Value
        .Cells(emptyrow, 7).Value = TextBox7.Value
        .Cells(emptyrow, 8).Value = TextBox8.Value
        .Cells(emptyrow, 9).Value = TextBox9.Value
    End With
End Sub

[snasui]

จาก Code ในโพสต์ #13 ปัจจุบันติดปัญหาตรงไหน อย่างไร ช่วยแจ้งรายละเอียดมาด้วยครับ

[Leng]

จากโพสต์ #13 คือติดปัญหาคือไม่สามารถ run ข้อมูลที่คีย์ลงต่อๆกันได้ครับ

[snasui]

อธิบายคำว่า "ไม่สามารถ run ข้อมูลที่คีย์ต่อ ๆ กันได้" มาอีกรอบว่ามีลักษณะเป็นอย่างไร

เกิดปัญหาอะไร โปรแกรมฟ้องว่าอย่างไร ฯลฯ ครับ

[Leng]

ข้อมูลที่คีย์ลงใน user from รอบที่ 2 เวลา scan ข้อมูลก็จะบันทึกทับกับข้อมูลอันที่ scan รอบ 1 ครับ ข้อมูลไม่บันทึกลงต่อๆกันครับ
"ตัว code ไม่มีปัญหาครับ"

[snasui]

จาก Code emptyrow = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Row ตัวแปร emptyrow เป็นการหาเซลล์ว่างเซลล์แรกในคอลัมน์ A หลังจากมีข้อมูล ดังนั้น คอลัมน์ A จะต้องมีข้อมูลทุกครั้งที่มีการบันทึก ห้ามเป็นเซลล์ว่าง ไม่เช่นนั้นต้องไปหาคอลัมน์ใด ๆ ที่มีข้อมูลอยู่ทุกบรรทัดมาใช้แทนครับ

[Leng]

ได้แล้วครับ ขอบคุณอาจารย์มากครับ

[Leng]

ขอถามเพิ่มเติมครับ
ผมต้องการเปิด 2 ไฟล์นี้พร้อมกันครับ โดยเปิดที่ final copy แล้วให้เปิดเป็นไฟล์ DataX.xlsx ขึ้นตามแล้วให้ขึ้น Userfrom ที่อยู่ในไฟลล์ final copy ครับ
แต่ปัญหาคือ
- สามารถเปิดได้ แต่โค๊ดขึ้น error เนื่องจาก พอเปิดไฟล์ final copy แล้วไปเปิด DataX.xlsx ตามทำให้หา Userfrom ไม่เจอครับ

Code: Select all

Private Sub Workbook_Open()

Worksheets("IN").Select
Workbooks.Open Filename:="C:\Users\Administrator\Desktop\Test\DataX.xlsx"
ADD.Show
Application.DisplayFullScreen = True
Application.CommandBars("Full Screen").Visible = False

End Sub