สอบถาม vlookup vba ครับ

[lnongkungl]

สวัสดีครับอาจารย์ วันนี้ผมมีเรื่องรบกวนสอบถามเกี่ยวกับการใช้ vlookup ด้วย vba ครับ

ผมกำลังฝึกใช้ vba ครับ เลยยังไม่ค่อยเข้าใจอย่างถ่องแท้

ผมจะ vlookup ข้าม sheet ครับ ลองเขียน code ดูก็ไม่มี error ครับ แต่ก็ไม่แสดงผลอะไรเลยเช่นกัน รบกวนอาจารย์ช่วยดูหน่อยครับว่าผมทำผิดตรงไหน ซึ่งตอนทดลองทำผมก็เปิดไฟล์ไว้ทั้ง 2 ไฟล์ครับ

Code: Select all

Sub lookup()
Dim name, lname As Range

Set name = Range("A2")
Set lname = Range("B2")

With Workbooks("a.xlsx").Worksheets(1)
Dim myrange As Range
Set myrange = Range("A:B")
End With

lname.Value = Application.WorksheetFunction.VLookup(name, myrange, 2, False)


End Sub

[puriwutpokin]

ปรับตามนี้ครับ

Code: Select all

Sub lookup()
Dim name, lname As Range
Set name = Range("A2:A8")
Set lname = Range("B2:B8")
With Workbooks("a.xlsx").Worksheets(1)
Dim myrange As Range
Set myrange = .Range("A:B")
End With
lname.Value = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 2, False), "")
End Sub

[lnongkungl]

ได้แล้วครับ แต่ผมรบกวนช่วยอธิบายตรงจุดที่ผมผิดพลาดให้หน่อยครับ ผมจะได้เอาไปปรับใช้ต่ออีกครับ

[puriwutpokin]

ได้แล้วครับ แต่ผมรบกวนช่วยอธิบายตรงจุดที่ผมผิดพลาดให้หน่อยครับ ผมจะได้เอาไปปรับใช้ต่ออีกครับ

ตรงนี้ครับ

Code: Select all

With Workbooks("a.xlsx").Worksheets(1)
Dim myrange As Range
Set myrange = .Range("A:B")
End With

เมื่อใช้ With แล้ว ช่วงที่กำหนด ต้องการให้สื่อถึง Workbooks("a.xlsx").Worksheets(1)
คือ ใส่จุด จาก

Code: Select all

 Range("A:B")

เป็น

Code: Select all

.Range("A:B")

[lnongkungl]

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

Code: Select all

Sub lookup()
Dim name, lname, r, t, m, e, sg As Range
Set name = Range("C4")
Set lname = Range("E4")
Set r = Range("G4")
Set t = Range("C7")
Set m = Range("C8")
Set e = Range("C9")
Set sg = Range("E12")
With Workbooks("a.xlsx").Worksheets(1)
Dim myrange As Range
Set myrange = .Range("A:G")
End With
lname.Value = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 2, False), "")
r.Value = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 3, False), "")
t.Value = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 4, False), "")
m.Value = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 5, False), "")
e.Value = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 6, False), "")
sg.Value = Application.IfError(Application.WorksheetFunction.VLookup(name, myrange, 7, False), "")
End Sub

[puriwutpokin]

ย่อได้เท่านี้ครับ
ลองดู

Code: Select all

Sub lookup()
Dim name, lname, myrange As Range
Set name = Range("C4")
Set lname = Range("E4")
With Workbooks("a.xlsx").Worksheets(1)
Set myrange = .Range("A:G")
End With
With Application
lname.Value = .IfError(.VLookup(name, myrange, 2, 0), "")
Range("G4") = .IfError(.VLookup(name, myrange, 3, 0), "")
Range("C7") = .IfError(.VLookup(name, myrange, 4, 0), "")
Range("C8") = .IfError(.VLookup(name, myrange, 5, 0), "")
Range("C9") = .IfError(.VLookup(name, myrange, 6, 0), "")
Range("E12") = .IfError(.VLookup(name, myrange, 7, 0), "")
End With
End Sub

[lnongkungl]

ขอบคุณครับ
ความหมายก็คือ ลดการประกาศตัวแปรเพิ่ม แค่เพิ่มตำแหน่งการ vlookup ถูกต้องมั้ยครับ

เดี๋ยวจะลองเอาไปปรับใช้กับของจริงดูครับ ติดตรงไหน จะเข้ามาขอความรู้เพิ่มเติมอีกครับ

[lnongkungl]

เจอปัญหาใหม่ครับ เมื่อ vlookup มาแล้ว มีการแก้ไขข้อมูล แล้วจะส่งข้อมูลไปบันทึกต่อท้ายตาราง แต่มันติด error ในการหาช่องว่างใน cell สุดท้ายของ row ครับ

Code: Select all

..Other code
name.Copy
Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\àÅÕ¹ẺDBform\a.xlsx")
Range("A" & Row.Count).End(xlUp).PasteSpecial xlPasteValues 'ติดที่บรรทัดนี้ครับ error ตลอด แก้ยังไงก็ติดทุกที
Application.CutCopyMode = fasle
Other code...

รบกวนด้วยครับ

[puriwutpokin]

ลองแนบไฟล์ตัวอย่างล่าสุดพร้อมโค้ดที่เกี่ยวข้องมาดูครับ จะได้เข้าถึงปัญหาได้ไวครับ

[lnongkungl]

แนบไฟล์ทดสอบครับ

[puriwutpokin]

ปรับเป็น

Code: Select all

' Other code...
Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\เลียนแบบDBform\a.xlsx")
name.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
' Other code...

[lnongkungl]

ก็ยังติดเหมือนเดิมครับ บรรทัดเดิมเลย

[puriwutpokin]

ลองแนบไฟล์ที่ใส่โค้ดนี้มาดูครับ
ไม่ก็ลองไฟล์นี้ดูครับ ผมรันก็ปกติครับ

[lnongkungl]

งง เหมือนกันครับ ช่วยดูให้ทีครับว่าผมพิมพ์อะไรผิดตรงไหน ผมก็เช็คดีแล้วนะครับว่ามันก็ไม่ผิด แต่ทำไมถึง error ไล่ดูทุกตัวอักษรก็ไม่ผิดนะครับ หรือผมพลาดตรงไหน

แต่ไฟล์ที่ท่าน puriwutpokin แนบมาผมเอามา run ได้นะครับ

งงไปใหญ่

[puriwutpokin]

ผิด 2 จุดครับ

Code: Select all

Range("A" & Row.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

ต้องเป็น ตกตัว Rows.Count ไม่ใส่ตัว S ตกไปครับ

Code: Select all

Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

และตรงนี้

Code: Select all

Application.CutCopyMode = fasle

ต้องเป็น สลับตำแหน่ง S กับ L

Code: Select all

Application.CutCopyMode = False

[lnongkungl]

ขอบคุณครับ ผมว่าผมหาดีแล้วนะ ยังพลาดได้

เมื่อเขียนครบจน run ได้ตามต้องการแล้ว ทีนี้มาดูในส่วนของการ copy ไปใส่ข้อมูลอีกที่นึง ดูแล้วมันจะยาวมากเลยครับ ขนาดแค่สร้างตารางมาเพื่อลองเขียนสูตรเล็กๆ ยังยาวขนาดนี้ พอจะมี Loop หรือ code ที่จะเขียนสั้นเพื่อลดความยาวของสูตรในจุดนี้ได้มั้ยครับ เพราะงานจิง column ยาวเป็น 100 เลย ไฟล์ตัวอย่างทดสอบนี่แค่ 7 column เองยังยาวขนาดนี้

Code: Select all

Sub save()
Dim name, lname, r, t, m, e, sg As Range
Set name = Range("C4")
Set lname = Range("E4")
Set r = Range("G4")
Set t = Range("C7")
Set m = Range("C8")
Set e = Range("C9")
Set sg = Range("E12")

'ตั้งแต่ตรงนี้
Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\àÅÕ¹ẺDBform\a.xlsx")
name.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
lname.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
r.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
t.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 3).PasteSpecial xlPasteValues
Application.CutCopyMode = False
m.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 4).PasteSpecial xlPasteValues
Application.CutCopyMode = False
e.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 5).PasteSpecial xlPasteValues
Application.CutCopyMode = False
sg.Copy
Range("A" & Rows.Count).End(xlUp).Offset(0, 6).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'ถึงตรงนี้

Workbooks("a.xlsx").save
Workbooks("a.xlsx").Close


End Sub

[puriwutpokin]

ลองปรับเป็น

Code: Select all

Sub save()
Dim name, lname, r, t, m, e, sg As Range
Set name = Range("C4")
Set lname = Range("E4")
Set r = Range("G4")
Set t = Range("C7")
Set m = Range("C8")
Set e = Range("C9")
Set sg = Range("E12")
Application.ScreenUpdating = False
Workbooks.Open ("C:\Users\it-support.cmk\Desktop\เลียนแบบDBform\a.xlsx")
 Range("A" & Rows.Count).End(xlUp).Offset(1).Value = name.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 1).Value = lname.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 2).Value = r.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 3).Value = t.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 4).Value = m.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 5).Value = e.Value
 Range("A" & Rows.Count).End(xlUp).Offset(, 6).Value = sg.Value
 ActiveWorkbook.save
 ThisWorkbook.Activate
 Application.ScreenUpdating = True
End Sub

[lnongkungl]

ขอบคุณครับท่าน puriwutpokin น่าจะลด code ได้หลายบรรทัดเลย เดี๋ยวลองดูครับ

[lnongkungl]

เจอปัญหาอีกแล้วครับ เมื่อ cell บาง cell ต้องพิมพ์ ==== หรือ ---- เพื่อเป็นตัวปิดยอดรวม ซึ่งมันใช้ border ของ cell ไม่ได้ เพราะมันจะไม่ตรงกับข้อความที่เราใส่เข้าไป ผมลอง copy ภายใน sheet เดียวกันไม่มีปัญหา code ไม่ติดอะไร

แล้วปัญหาก็ติดอยู่ที่ว่า เมื่อ copy.value ข้าม sheet แล้ว code จะ error ทันทีเมื่อเจอข้อความชุดนี้ เพราะจะติดข้อความถามให้ใส่ ' ให้ของ excel

ผมใช้ application.displayalerts = true ก็ไม่ได้ผลครับ พยายามหาใน google แล้วก็ไม่เจอซักที

รบกวนด้วยครับ

[puriwutpokin]

เปลี่ยน เอา Value ออกตามนี้ครับ

Code: Select all

 Range("A" & Rows.Count).End(xlUp).Offset(1) = name
 Range("A" & Rows.Count).End(xlUp).Offset(, 1) = lname
 Range("A" & Rows.Count).End(xlUp).Offset(, 2) = r
 Range("A" & Rows.Count).End(xlUp).Offset(, 3) = t
 Range("A" & Rows.Count).End(xlUp).Offset(, 4) = m
 Range("A" & Rows.Count).End(xlUp).Offset(, 5) = e
 Range("A" & Rows.Count).End(xlUp).Offset(, 6) = sg