EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Private Sub CommandButton1_Click()
On Error Resume Next
Dim myRange As Range
Set myRange = Worksheets("Database").Range("_Data")
On Error Resume Next
TextBox2.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 3, False)
TextBox3.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 4, False)
TextBox4.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 5, False)
TextBox5.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 6, False)
TextBox6.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 7, False)
ComboBox1.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 8, False)
ComboBox2.Value = _
Application.WorksheetFunction.VLookup(--(TextBox1.Value), myRange, 9, False)
End Sub
_Data
เป็นApplication.WorksheetFunction.VLookup([color=#FF0000]--([/color]TextBox1.Value[color=#FF0000])[/color], myRange, 3, False)
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 3, False)
Code: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,3, False)
Code: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,2, False)
ขอบคุณครับ ลองปรับแล้วใช้งานได้ครับ ในส่วนหากต้องการเพิ่มข้อมูลหรือแก้ไขข้อมูลจกาที่ค้นหาหรือเพิ่มใหม่ควรปรับแก้อย่างไรครับDhitiBank wrote:ลองแบบนี้ครับ
1. ปรับสูตร range name ชื่อ_Data
เป็น
=OFFSET(Database!$A$1,1,1,COUNTA(Database!$A:$A)-1,COUNTA(Database!$1:$1)-1)
2. ปรับโค้ดในส่วนที่เป็น Vlookup นิดหน่อยครับ
จากเดิม
Application.WorksheetFunction.VLookup([color=#FF0000]--([/color]TextBox1.Value[color=#FF0000])[/color], myRange, 3, False)
เป็น
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange, 3, False)
เอาออกให้หมด แล้วลองรันโค้ดดูใหม่ครับ
ปรับแล้วใช้ได้ครับ ขอบคุณครับ แต่ติดปัญหาใหม่ครับว่าจะกดเพิ่มข็อมูลหรือกดเพื่อแก้ไขบางรายการที่ค้นหามาแล้วให้กลับไปไว้ที่จุดที่ค้นหาออกมาครับpuriwutpokin wrote:ตาม คุณDhitiBank ให้เปลี่ยนลำดับการค้นหาตามกันไปด้วยเป็นCode: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,3, False)
รันลดไปเรื่อยนะครับ 4 เป็น 3 และตัวต่อไปด้วยครับCode: Select all
Application.WorksheetFunction.VLookup(TextBox1.Value, myRange,2, False)
ขอบคุณมากๆครับ ขอทดสอบดูก่อนนะครับpuriwutpokin wrote:ลองดูตามไฟล์แนบครับติดตรงไหนค่อยมาดูกันอีกทีครับ
Code: Select all
Private Sub CommandButton2_Click()
Dim icolumn As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Database")
'find first empty row in database
icolumn = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row
'Check for Id
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
'copy the data to the database
ws.Cells(icolumn, 2).Value = Me.TextBox1.Value
ws.Cells(icolumn, 3).Value = Me.TextBox2.Value
ws.Cells(icolumn, 4).Value = Me.TextBox3.Value
ws.Cells(icolumn, 5).Value = Me.TextBox4.Value
ws.Cells(icolumn, 6).Value = Me.TextBox5.Value
ws.Cells(icolumn, 7).Value = Me.TextBox6.Value
ws.Cells(icolumn, 8).Value = Me.ComboBox1.Value
ws.Cells(icolumn, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "เพิ่มข้อมูลเรียบร้อย"
Else
If Trim(Me.TextBox1.Value) = "" Then
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
iRow = _
Application.WorksheetFunction.Match(TextBox1.Value, ws.Range("B2:B10000"), 0) + 1
ws.Cells(iRow, 2).Value = Me.TextBox1.Value
ws.Cells(iRow, 3).Value = Me.TextBox2.Value
ws.Cells(iRow, 4).Value = Me.TextBox3.Value
ws.Cells(iRow, 5).Value = Me.TextBox4.Value
ws.Cells(iRow, 6).Value = Me.TextBox5.Value
ws.Cells(iRow, 7).Value = Me.TextBox6.Value
ws.Cells(iRow, 8).Value = Me.ComboBox1.Value
ws.Cells(iRow, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "แก้ไขข้อมูลเรียบร้อย"
End If
End If
End If
End Sub
ถ้าเราจะเพิ่มกล่องรับวันที่ ที่เราจัดเก็บข้อมูลเข้าไปสามารถเพิ่มได้ไหมครับpuriwutpokin wrote:หรือทำเป็นปุ๋มเดียวก็ปรับตามโค้ดนี้ครับใช้ฟอร์มเดิมครับCode: Select all
Private Sub CommandButton2_Click() Dim icolumn As Long Dim iRow As Long Dim ws As Worksheet Set ws = Worksheets("Database") 'find first empty row in database icolumn = ws.Cells(Rows.Count, 2) _ .End(xlUp).Offset(1, 0).Row 'Check for Id If Trim(Me.TextBox1.Value) = "" Then Me.TextBox1.SetFocus MsgBox "คุณยังไม่ได้ใส่ข้อมูล" Exit Sub Else If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then 'copy the data to the database ws.Cells(icolumn, 2).Value = Me.TextBox1.Value ws.Cells(icolumn, 3).Value = Me.TextBox2.Value ws.Cells(icolumn, 4).Value = Me.TextBox3.Value ws.Cells(icolumn, 5).Value = Me.TextBox4.Value ws.Cells(icolumn, 6).Value = Me.TextBox5.Value ws.Cells(icolumn, 7).Value = Me.TextBox6.Value ws.Cells(icolumn, 8).Value = Me.ComboBox1.Value ws.Cells(icolumn, 9).Value = Me.ComboBox2.Value 'Clear the data Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.ComboBox1.Value = "" Me.ComboBox2.Value = "" Me.TextBox1.SetFocus MsgBox "เพิ่มข้อมูลเรียบร้อย" Else If Trim(Me.TextBox1.Value) = "" Then MsgBox "คุณยังไม่ได้ใส่ข้อมูล" Exit Sub Else iRow = _ Application.WorksheetFunction.Match(TextBox1.Value, ws.Range("B2:B10000"), 0) + 1 ws.Cells(iRow, 2).Value = Me.TextBox1.Value ws.Cells(iRow, 3).Value = Me.TextBox2.Value ws.Cells(iRow, 4).Value = Me.TextBox3.Value ws.Cells(iRow, 5).Value = Me.TextBox4.Value ws.Cells(iRow, 6).Value = Me.TextBox5.Value ws.Cells(iRow, 7).Value = Me.TextBox6.Value ws.Cells(iRow, 8).Value = Me.ComboBox1.Value ws.Cells(iRow, 9).Value = Me.ComboBox2.Value 'Clear the data Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.ComboBox1.Value = "" Me.ComboBox2.Value = "" Me.TextBox1.SetFocus MsgBox "แก้ไขข้อมูลเรียบร้อย" End If End If End If End Sub
ขอบคุณครับลองปรับใส่วันที่แล้ว ได้ผลตามต้องการครับ แต่ติดปัญหาตรงที่ใน Textbox7 จะโชว์วันที่ในรูปแบบที่เป็นตัวเลข แบบนี้ครับ 241136 ซึ่งค่าในชีต Database คือ 15 มีนาคม 2560 ( พิมพ์ 15/3/2017) แก้แบบไหนดีครับpuriwutpokin wrote:ก็ทำได้เมื่อ TextBox อื่นๆครับ ลองเขียนมาดูก่อนครับ ติดขัดแล้วค่อยมาถามกันใหม่ครับ
Code: Select all
Private Sub UserForm_Initialize()
TextBox7.Value = Format(Date, "dd mmmm yyyy")
A = "Person!_Type"
ComboBox1.RowSource = A
B = "Person!_Person"
ComboBox2.RowSource = B
End Sub
Code: Select all
Private Sub CommandButton2_Click()
Dim icolumn As Long
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Database")
'find first empty row in database
icolumn = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row
'Check for Id
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
'copy the data to the database
ws.Cells(icolumn, 2).Value = Me.TextBox1.Value
ws.Cells(icolumn, 3).Value = Me.TextBox2.Value
ws.Cells(icolumn, 4).Value = Me.TextBox3.Value
ws.Cells(icolumn, 5).Value = Me.TextBox4.Value
ws.Cells(icolumn, 6).Value = Me.TextBox5.Value
ws.Cells(icolumn, 7).Value = Me.TextBox6.Value
ws.Cells(icolumn, 8).Value = Me.ComboBox1.Value
ws.Cells(icolumn, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "เพิ่มข้อมูลเรียบร้อย"
Else
If Trim(Me.TextBox1.Value) = "" Then
MsgBox "คุณยังไม่ได้ใส่ข้อมูล"
Exit Sub
Else
iRow = _
Application.WorksheetFunction.Match(TextBox1.Value, ws.Range("B2:B10000"), 0) + 1
ws.Cells(iRow, 2).Value = Me.TextBox1.Value
ws.Cells(iRow, 3).Value = Me.TextBox2.Value
ws.Cells(iRow, 4).Value = Me.TextBox3.Value
ws.Cells(iRow, 5).Value = Me.TextBox4.Value
ws.Cells(iRow, 6).Value = Me.TextBox5.Value
ws.Cells(iRow, 7).Value = Me.TextBox6.Value
ws.Cells(iRow, 8).Value = Me.ComboBox1.Value
ws.Cells(iRow, 9).Value = Me.ComboBox2.Value
'Clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "แก้ไขข้อมูลเรียบร้อย"
End If
End If
End If
End Sub
ได้แนบไฟล์มาแล้วครับ และหากต้องการให้กดค้นหาแล้วไม่พบข้อมูลให้ MsgBox ขึ้นว่าไม่พบข้อมูลด้วยผมลองแล้วไม่สามารถทำได้ครับpuriwutpokin wrote:แนบไฟล์ล่าสุดมาดู ครับจะได้เข้าใจตรงกันครับ
Code: Select all
...Other code
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
...Other code
ค่าใน Textbox1 ไม่ว่างนี่สิครับเพราะเราใส่คำเข้าไปให้ค้นหาpuriwutpokin wrote:Code: Select all
...Other code If Trim(Me.TextBox1.Value) = "" Then Me.TextBox1.SetFocus ...Other code
Code: Select all
...Other code
If Trim(Me.TextBox1.Value) = "" Or Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
...Other code
ผลออกมาว่า การค้นหา ไม่พบทั้งหมดเลย ทั้งๆที่ข้อมูลมีครับpuriwutpokin wrote:Code: Select all
...Other code If Trim(Me.TextBox1.Value) = "" Or Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then ...Other code
Code: Select all
...other code On Error Resume Next
Dim ws As Worksheet
Set ws = Worksheets("Database")
Dim myRange As Range
Set myRange = Worksheets("Database").Range("_Data")
If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then
Me.TextBox1.SetFocus
MsgBox "ไม่พบข้อมูล", vbInformation, "ระบบค้นหาสำนวน"
Exit Sub...other code
ใช้ได้แล้วครับขึ้นโชว์ข้อความตามที่ต้องการ ขอบคุณครับpuriwutpokin wrote:แก้ไขโค้ดครับCode: Select all
...other code On Error Resume Next Dim ws As Worksheet Set ws = Worksheets("Database") Dim myRange As Range Set myRange = Worksheets("Database").Range("_Data") If Application.CountIf(ws.Range("B2:B10000"), Trim(Me.TextBox1.Value)) = 0 Then Me.TextBox1.SetFocus MsgBox "ไม่พบข้อมูล", vbInformation, "ระบบค้นหาสำนวน" Exit Sub...other code