ตรวจสอบและปรับปรุงไฟล์ Excel ให้เร็วและเสถียรด้วย File Anatomy Add-in
เครื่องมือนี้ช่วยวิเคราะห์โครงสร้างไฟล์อย่างละเอียด เช่น สูตร, ลิงก์, PivotTable, Styles และ Objects
พร้อมฟังก์ชันล้างสิ่งเกินจำเป็นที่ทำให้ไฟล์ช้า หรือเสียหายได้ในคลิกเดียว
เหมาะสำหรับผู้ใช้ Excel ที่ต้องการควบคุมคุณภาพไฟล์อย่างมืออาชีพ
ทดลองใช้ Add-in
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
ระบุ Version ของ Excel 
โปรดทราบ สมัครสมาชิก
Login ผ่าน Facebook Reset รหัสผ่าน ติดต่อผู้ดูแลระบบ ตั้งค่าส่วนตัว วิธีการตั้งและตอบกระทู้ จัดรูปแบบตัวอักษร กำหนดขนาดตัวอักษรใน Browser
คำแสดงเจตนา[code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
ก่อนอื่นต้องถามอาจารย์ก่อนว่า เราจะสามารถดึงข้อมูลมาจาก Database มาแสดงบนฟอร์มที่เราเตรียมไว้แล้วได้หรือไม่ 
สามารถทำได้ครับ ในขั้นแรกอย่าเพิ่งไปกังวลกับเรื่องอื่นให้มากไปครับ ขอให้ทำงานได้ระดับหนึ่งก่อน เราค่อยพัฒนาต่อยอดไปได้เรื่อย ๆ ประสบการณ์และความรู้ที่เพิ่มขึ้นจะช่วยให้เราหาวิธีที่เหมาะสมได้ในลำดับต่อไป
รายงานผลนิดนึงครับ ตอนนี้ยังไม่คืบหน้าเลยครับ ผมยังหาวิธีดึงข้อมูลมาแสดงบนฟอร์มไ่ม่ได้เลย เคยดูตัวอย่างการดึงข้อมูลแบบเก่า (ต้นทางปลายทางมีรูปแบบเหมือนกัน) อาจารย์ ต้องยอมแพ้ครับ ผมปรับสูตรไม่ได้จริงๆ ยังไงผมก็อยากดูตัวอย่างก่อนครับถึงจะทำได้ ชีท Form ให้จัดช่อง Name เสียใหม่ครับ ไม่เช่นนั้นข้อมูลต้นแหล่งกับข้อมูลปลายทางมีขนาดไม่เท่ากัน หรือจะให้วางอย่างไรช่วยกรอกข้อมูลมาเป็นตัวอย่างด้วยครับCode: Select all
Sub PullToEdit()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Set rFind = Sheets("Form").Range("I7")
If Sheets("Form").Range("I7") = "" Then Exit Sub
With Sheets("Data")
Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("ไม่มีเลข PO นี้")
Exit Sub
End If
End With
For Each r In rDataAll
If r = rFind Then
Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
.Offset(1, 0)
r.Offset(0, 2).Resize(1, 4).Copy
rTarget.PasteSpecial xlPasteValues
End If
With Sheets("Form")
.Range("C3") = r: .Range("F3") = r.Offset(0, 1)
End With
Next r
Application.CutCopyMode = False
MsgBox "Get data has finished."
End Sub
Code: Select all
Sub PullToEdit()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Set rFind = Sheets("Form").Range("F4")
If Sheets("Form").Range("F4") = "" Then Exit Sub
With Sheets("Data")
Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("äÁèÁÕàÅ¢ QO ¹Õé")
Exit Sub
End If
End With
For Each r In rDataAll
If r = rFind Then
Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
.Offset(1, 0)
r.Offset(0, 2).Resize(1, 3).Copy
rTarget.PasteSpecial xlPasteValues
With Sheets("Form")
.Range("F3") = r.Offset(0, 1)
End With
End If
Next r
Application.CutCopyMode = False
MsgBox "Get data has finished."
End Sub
สูตรไหนครับ 
คือผมเอาสูตร 
Code: Select all
Sub PullToEdit()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Set rFind = Sheets("Form").Range("F4")
If Sheets("Form").Range("F4") = "" Then Exit Sub
With Sheets("Data")
Set rDataAll = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
If .Columns("A:A").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("äÁèÁÕàÅ¢ QO ¹Õé")
Exit Sub
End If
End With
For Each r In rDataAll
If r = rFind Then
Set rTarget = Sheets("Form").Range("B" & Rows.Count).End(xlUp) _
.Offset(1, 0)
r.Offset(0, 2).Resize(1, 3).Copy
rTarget.PasteSpecial xlPasteValues
With Sheets("Form")
.Range("F3") = r.Offset(0, 1)
End With
End If
Next r
Application.CutCopyMode = False
MsgBox "Get data has finished."
End Sub
Code: Select all
Private Sub CommandButton1_Click()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Dim irow As Long
Dim ws As Worksheet
Sheets("PurchaseOrder").Unprotect Password:="240130" '<==UnProtect
Set ws = Worksheets("PurchaseOrder")
'find first empty row in database
irow = ws.Cells("8") _
.End(xlUp).Range("H10").Row
'Check for Id
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "เลือกหน่วยงาน"
Exit Sub
End If
'copy the data to the database
ws.Cells(irow, 8).Value = Me.TextBox1.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox1.SetFocus
Set rFind = Sheets("PurchaseOrder").Range("H10")
If Sheets("PurchaseOrder").Range("H10") = "" Then Exit Sub
With Sheets("Data")
Set rDataAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
If .Columns("B:B").Find(rFind, LookIn:=xlValues) Is Nothing Then
MsgBox ("ไม่มีเลขที่ QO นี้")
Exit Sub
End If
End With
For Each r In rDataAll
If r = rFind Then
Set rTarget = Sheets("PurchaseOrder").Range("B" & Rows.Count).End(xlUp) _
.Offset(1, 0)
rTarget = r.Offset(0, 1)
rTarget.Offset(0, 1) = r.Offset(0, 2)
rTarget.Offset(0, 5) = r.Offset(0, 3)
rTarget.Offset(0, 6) = r.Offset(0, 4)
With Sheets("PurchaseOrder")
.Range("I13") = r ': .Range("C7") = r.Offset(0, 1)
End With
End If
Next r
Application.CutCopyMode = False
MsgBox "Get data has finished."
Sheets("PurchaseOrder").Select
If Sheets("PurchaseOrder").Select Then
UserForm6.Hide
End If
Sheets("PurchaseOrder").Protect Password:="240130" '<== Protect Again
End Sub
อันนี้ลองปรับเองครับ ซึ่งคิดว่าเป็นเรื่องง่าย ๆ ครับ ต้องยอมรับว่าอาจารย์สับขาหลอกผมไว้เยอะ ทำเอาผมมึนกันไปหลายตลบเลยทีเดียวครับ
ผมยังพยายามหาวิธแก้อยู่ครับ แต่ก็ยังไม่ได้