ใช้ VBA Vlookup ข้ามไฟล์ ได้อย่างไร

[nararat]

ขอคำ แนะนำจากอาจาร์ยนะครับ
ผมมีปัญหาเรื่อง Vlookup ข้ามไฟล์ ไม่ขึ้น Error ขอคำแนะนำหน่อยนะครับ

Code: Select all

Sub mylookupPR()
    Dim lastrow As Long
    lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    Set myrange = Workbooks("G\B\tan\data2.xls").Sheets1.Range("A:D")
   '...Other code
On Error Resume Next
For i = 1 To lastrow
    Cells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 1), myrange, 13, False)
    Cells(i, 6).Value = Cells(i, 6).Value
    Cells(i, 7) = Application.WorksheetFunction.VLookup(Cells(i, 1), myrange, 14, False)
    Cells(i, 7).Value = Cells(i, 7).Value
Next i
End Sub

ผมเอาไฟล์ data2 เป็นไฟล์ข้อมูล ไว้ใน ไดร์ G\B\tan\data2.xls

data2.xls

(81 KiB) Downloaded 24 times

แล้วใช้ Lineup เป็นตัวแสดงข้อมูล

The attachment Lineup.xlsm is no longer available

ขอบคุณนะครับ

[nararat]

Lineup.xlsm

(20.13 KiB) Downloaded 26 times

[puriwutpokin]

ลองดูนะครับ

Code: Select all

Sub mylookupPR()
    Dim lastrow As Long
    lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    Set myrange = Workbooks("data2.xls").Sheets("Sheet1").Range("A:N")
On Error Resume Next
For i = 4 To lastrow
    Cells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 1), myrange, 14, False)
    'Cells(i, 6).Value = Cells(i, 6).Value
    Cells(i, 7) = Application.WorksheetFunction.VLookup(Cells(i, 1), myrange, 13, False)
    'Cells(i, 7).Value = Cells(i, 7).Value
Next i
End Sub

[nararat]

ขอบคุณครับ

เหมือนว่าถ้าไม่เปิด ไฟล์ data2.xls ไว้แล้วกด run จะ error

run time error 9

ขอถามอาจาร์ยอีกหน่อยนะครับ ถ้า data2.xls ไม่ได้เก็บไว้ที่เดียวกัน จะต้องเขียนโค๊ะอย่างไรครับ
ขอบคุณครับ

[puriwutpokin]

ตามหลักของ Vlookup ต้องเปิดไฟล์ต้นทางไว้
ไม่งั้นก็ต้องสั่งเปิดและปิดปรับเป็น

Code: Select all

Sub mylookupPR()
Dim sFilename As String
Dim myrange, myValue
Dim lastrow As Long
lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 4 To lastrow
sFilename = "G\B\tan\data2.xls"
With GetObject(sFilename)
    myrange = .Sheets("Sheet1").Range("A:N")
   Cells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 1), myrange, 14, False)
   Cells(i, 7) = Application.WorksheetFunction.VLookup(Cells(i, 1), myrange, 13, False)
    .Close
End With
Next i
Application.ScreenUpdating = True
End Sub

[nararat]

ขอบคุณครับ

[nararat]

เหมือน run ไปจะ error ที่
With GetObject(sFileName)
แล้วขึ้น error แล้วไปต่อไม่ได้ครับผม

[snasui]

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

Code: Select all

Dim lastrow As Long, wb As Workbook
Dim myrange As Range, tb As Workbook
Set tb = ThisWorkbook
With tb.Sheets(1)
    lastrow = .Range("a" & .Rows.Count).End(xlUp).Row
End With
Set wb = Workbooks.Open("G\B\tan\data2.xls")
Set myrange = wb.Sheets(1).Range("a:n")
On Error Resume Next
For i = 4 To lastrow
    With tb.Sheets(1)
        .Cells(i, 6) = Application.WorksheetFunction.VLookup( _
            .Cells(i, 1), myrange, 13, False)
        .Cells(i, 7) = Application.WorksheetFunction.VLookup( _
            .Cells(i, 1), myrange, 14, False)
    End With
Next i
wb.Close False

[nararat]

ขอบคุณครับอาจาร์ย