ตรวจสอบและปรับปรุงไฟล์ 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] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
จำเป็นต้องเขียนมาเองแล้วถามที่ติดปัญหาครับรบกวนอาจารย์ด้วยครับ ตอนี้เริ่มจะเป็นรูปเป็นร่างพอสมควร ตอนนี้อยู่ 2 จุดสำคัญครับsnasui wrote:
Vlookup_VBA.xls เนื่องจาก Code ที่เขียนให้ Lookup ชื่อมานั้นไม่ถูกต้องจากเดิม
Code: Select all
Name = Application.VLookup(LookFor.Value.Rng, ColName, 0)Code: Select all
Name = Application.VLookup(LookFor.Value, Rng, ColName, 0)Code: Select all
Private Sub CommandButton1_Click()
Dim LookFor As Range
Dim Rng As Range
Dim ColAmount As Integer
Dim ColName As Integer
Dim Found As Variant
Dim Name As Variant
Dim rAll As Range
Dim r As Range
Set LookFor = Sheets("Sheet2").Range("A1")
Set Rng = Sheets("Sheet1").Columns("A:C")
With Sheets("Sheet2")
Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
End With
ColName = 2
ColAmount = 3
On Error Resume Next
For Each r In rAll
Found = Application.VLookup(r, Rng, ColAmount, 0)
Name = Application.VLookup(r, Rng, ColName, 0)
If IsError(Found) Then
MsgBox LookFor & "äÁ辺¢éÍÁÙÅ"
Else ': MsgBox "The look-up value of " & LookFor & " is " & Found & " in column " & Col
r.Offset(0, 2) = Found
End If
If IsError(Name) Then
MsgBox LookFor & "äÁ辺¢éÍÁÙÅ"
Else
r.Offset(0, 1) = Name
End If
Next r
On Error GoTo 0
End Sub
ขอบคุณมากครับอาจารย์ พิมพ์ผิดนี้เอง ไม่ฟ้อง Error ด้วย ผมก็งมตรงนี้อยู่นานsnasui wrote:ให้ปรับเป็นCode: Select all
Name = Application.VLookup(LookFor.Value.Rng, ColName, 0)กรณีต้องการ Lookup เรียงลงมาเรื่อย ๆ ก็สามารถใช้การ Loop เช่น For...Each...Next เข้ามาช่วยดูตัวอย่างตามด้านล่างครับCode: Select all
Name = Application.VLookup(LookFor.Value, Rng, ColName, 0)Code: Select all
Private Sub CommandButton1_Click() Dim LookFor As Range Dim Rng As Range Dim ColAmount As Integer Dim ColName As Integer Dim Found As Variant Dim Name As Variant Dim rAll As Range Dim r As Range Set LookFor = Sheets("Sheet2").Range("A1") Set Rng = Sheets("Sheet1").Columns("A:C") With Sheets("Sheet2") Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) End With ColName = 2 ColAmount = 3 On Error Resume Next For Each r In rAll Found = Application.VLookup(r, Rng, ColAmount, 0) Name = Application.VLookup(r, Rng, ColName, 0) If IsError(Found) Then MsgBox LookFor & "äÁ辺¢éÍÁÙÅ" Else ': MsgBox "The look-up value of " & LookFor & " is " & Found & " in column " & Col r.Offset(0, 2) = Found End If If IsError(Name) Then MsgBox LookFor & "äÁ辺¢éÍÁÙÅ" Else r.Offset(0, 1) = Name End If Next r On Error GoTo 0 End Sub
Code: Select all
With Sheets("Sheet2")
Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
End WithCode: Select all
For Each r In rAll
Process .....
Next rCode: Select all
With Sheets("Sheet2")
Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) 'กำหนดให้ rAll มีค่าตั้งแต่ A1 จนถึงค่า A สุดท้ายที่มีข้อมูล
End WithCode: Select all
For Each r In rAll
Process ..... ' Process คือการดำเนินการกับสมาชิกแต่ละตัว (แทนค่าด้วย r) ใน rAll
Next rขอบคุณครับอาจารย์snasui wrote:Code: Select all
With Sheets("Sheet2") Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) 'กำหนดให้ rAll มีค่าตั้งแต่ A1 จนถึงค่า A สุดท้ายที่มีข้อมูล End WithCode: Select all
For Each r In rAll Process ..... ' Process คือการดำเนินการกับสมาชิกแต่ละตัว (แทนค่าด้วย r) ใน rAll Next r
Code: Select all
Set FoundRange = Columns(1).Find(What:=Range("A" & Rows.Count).End(xlUp)) 'ãËéËÒ¤Ó·ÕèàËÁ×͹㹠Colum A
If Not (FoundRange Is Nothing) Then '¶éÒà¨ÍÇèÒ«éÓ
MsgBox ("ÁÕ¢éÍÁÙÅ«éÓã¹°Ò¹¢éÍÁÙÅ")
Range("A" & Rows.Count).End(xlUp) = ""
Range("A" & Rows.Count).End(xlUp).Activate
GoTo EndProcess
End IfCode: Select all
If IsError(Amount) Then
Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.ColorIndex = 3
Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.Bold = True
Else
r.Offset(0, 2) = Amount
End IfCode: Select all
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range
Dim ColAmount As Integer
Dim ColName As Integer
Dim Amount As Variant
Dim Name As Variant
Dim rAll As Range
Dim r As Range
Dim FoundRange As Range
If Range("A" & Rows.Count).End(xlUp) <> "" Then
Set FoundRange = Columns(1).Find(What:=Range("A" & Rows.Count).End(xlUp)) 'ãËéËÒ¤Ó·ÕèàËÁ×͹㹠Colum A
If Not (FoundRange Is Nothing) Then '¶éÒà¨ÍÇèÒ«éÓ
MsgBox ("ÁÕ¢éÍÁÙÅ«éÓã¹°Ò¹¢éÍÁÙÅ")
Range("A" & Rows.Count).End(xlUp) = ""
Range("A" & Rows.Count).End(xlUp).Activate
GoTo EndProcess
End If
Set LookFor = Sheets("Sheet2").Range("A1")
Set Rng = Sheets("Sheet1").Columns("A:C")
With Sheets("Sheet2")
Set rAll = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
End With
ColName = 2
ColAmount = 3
On Error Resume Next
For Each r In rAll
Amount = Application.VLookup(r, Rng, ColAmount, 0)
Name = Application.VLookup(r, Rng, ColName, 0)
If IsError(Amount) Then
Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.ColorIndex = 3
Range("A" & Rows.Count).End(xlUp).Application.Selection.Font.Bold = True
Else
r.Offset(0, 2) = Amount
End If
If IsError(Name) Then
'MsgBox r.Offset(0, 0) & " äÁèÁÕª×èÍÅÙ¡¤éÒã¹°Ò¹¢éÍÁÙÅ"
'r.Offset(0, 0) = "" '·ÓãËé¢éÍÁÙÅ㹺Ã÷ѴÊØ´ã¹ Column A à»ç¹ ÇèÒ§
'r.Offset(0, 0).Activate '仺Ã÷ѴÊØ´·éÒÂã¹ Column A
Exit Sub
Else
r.Offset(0, 1) = Name
End If
Next r
End If
EndProcess:
On Error GoTo 0
End Subรบกวนด้วยครับsnasui wrote:
Vlookup_VBA.xls ช่วยอธิบายเพิ่มเติมเป็นลำดับครับว่าผมต้องทดสอบอย่างไร ค่าทดสอบคือค่าใดบ้าง ผลลัพธ์ที่ต้องการคืออะไร การที่บอกว่าหาค่าที่เหมือนกันในคอลัมน์ A หาค่าใดในช่วงข้อมูลใด หากเจอ ต้องการให้แสดงผลอย่างไร หากไม่เจอ ต้องการให้แสดงผลอย่างไรขออภัยครับsnasui wrote:
เพิ่มเติมนิดครับ ลืมตอบคำถามอาจารย์เรื่องใช้ค่าใดในการทดสอบ ค่าที่ใช้ในการทดสอบอยู่ใน sheets1 ครับ ผมทำไว้ 4 รายการครับakung wrote:ขออภัยครับsnasui wrote:
คือพอเราคีย์ข้อมูลใน Sheet2 ColumnA ที่ช่อง A1 = 12345 ระบบจะดึงข้อมูลจาก Sheets1 ColumnB และ ColumnC มาใส่ใน Sheets2 ColumnB และ C (เปรียบเสมือ Vlookup)
ปัญหาที่ 1 นะครับ คือสมมุติว่า ผมคีย์ข้อมูลไป 100 รายแล้ว แต่บังเอิญว่ามีการคีย์ข้อมูลซ้ำเหมือนใน 100 ราย ที่คีย์ไปแล้ว อยากให้ระบบแจ้งว่ามีการคีย์ข้อมูลไปแล้วหรือข้อมูลซ้ำกับในข้อมูลที่คีย์ไป
ปัญหาที่ 2 คือพอเราคีย์ข้อมูลใน Sheet2 ColumnA สมมุติที่ช่อง A101 = 12349 ระบบจะเข้าไปค้นหาแล้วดึงข้อมูลมา แต่บังเอิญว่า รหัส 12349 ไม่มีในฐานข้อมูล ก็ขอให้ระบบ ทำให้ รหัส 12349 เป็นตัวสีแดง และเป็นตัวหนา เพื่อให้เห็นความแตกต่างกันระหว่าง ข้อมูลที่มีในฐานข้อมูลหลัก (Sheets1) กับข้อมูลที่ไม่มีในฐานข้อมูลหลัก
สรุปครับ หลักการคือ
1. มีการเช็คข้อมูลที่คีย์เข้าไปใหม่ว่ามีในฐานข้อมูลที่คีย์เข้าไปแล้ว หรือไหมถ้ามีคีย์ซ้ำให้แจ้ง แต่ก็สามารถให้คีย์ซ้ำได้ครับ
2. ถ้าข้อมูลที่คีย์ ระบบเ้ข้าไปค้นหาในฐานข้อมูลหลักแล้วไม่เจอ ให้เปลี่ยนสีในข้อมูลที่คีย์เป็นสีแดง แล้วตัวหนา ครับ
รบกวนด้วยครับ
ลองดูตัวอย่าง Code ตามด้านล่างครับ
Code: Select all
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim rCheck As Range
Dim ColAmount As Integer
Dim ColName As Integer
Dim lng As Long
If Target.Column = 1 Then
With Sheets("Sheet2")
Set rCheck = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
End With
With Sheets("Sheet1")
Set Rng = .Range("A1", .Range("C" & Rows.Count).End(xlUp))
End With
ColName = 2
ColAmount = 3
On Error Resume Next
lng = Application.CountIf(Rng.Resize(, 1), Target)
If lng >= 1 Then
If Application.CountIf(Target, rCheck) > 1 Then
MsgBox ("Double!!!")
End If
Target.Offset(0, 2) = Application.VLookup(Target, Rng, ColAmount, 0)
Target.Offset(0, 1) = Application.VLookup(Target, Rng, ColName, 0)
Else
Target.Font.Color = vbRed
Target.Font.Bold = True
End If
End If
End Subผลการทดสอบครับอาจารย์ Error ที่บรรทัด If Target.Column = 1 Then ครับ ผมเลยลองเปลี่ยนเป็น If Range("A" & Rows.Count).End(xlUp) <> "" Thensnasui wrote:Code: Select all
Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Dim rCheck As Range Dim ColAmount As Integer Dim ColName As Integer Dim lng As Long If Target.Column = 1 Then With Sheets("Sheet2") Set rCheck = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) End With With Sheets("Sheet1") Set Rng = .Range("A1", .Range("C" & Rows.Count).End(xlUp)) End With ColName = 2 ColAmount = 3 On Error Resume Next lng = Application.CountIf(Rng.Resize(, 1), Target) If lng >= 1 Then If Application.CountIf(Target, rCheck) > 1 Then MsgBox ("Double!!!") End If Target.Offset(0, 2) = Application.VLookup(Target, Rng, ColAmount, 0) Target.Offset(0, 1) = Application.VLookup(Target, Rng, ColName, 0) Else Target.Font.Color = vbRed Target.Font.Bold = True End If End If End Sub
มันไม่ควรจะ Error ครับ ผมทดสอบแล้วเป็นปกติ Code นั้นผมเขียนเพื่อดักว่าการป้อนข้อมูลให้ป้อนที่คอลัมน์ A เท่านั้น สามารถลบออกหรือ Mark เป็น Comment ออกไปก็ได้ครับ และอย่าลืม Mark End If ออกไปด้วยครับผม Mark เป็น Commnet แล้วครับ แต่ผลลัพธ์ก็ไม่ออกครับ คือผมลองคีย์ 12345 ระบบควรจะดึงข้อมูลมาแต่ไม่มีครับ ผมลองทั้ง 2003 และ 2007 ผลลัพธ์ก็ไม่ออกเหมือนเดิมครับsnasui wrote:
มันจะดึงข้อมูลมาให้ได้ก็ต่อเมื่อค่าที่คีย์เป็นประเภทเดียวกัน เช่นเป็นตัวเลขเหมือนกัน เป็น Text เหมือนกัน จากไฟล์ที่แนบมาได้กำหนดให้เป็น Text แต่ต้นทางเป็น Number ครับ การ Lookup และการ Match ต้องคำนึงถึงสิ่งเหล่านี้เป็นลำดับแรกเสมอจะลืมไม่ได้ครับ