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]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)อธิบายเพิ่มเติมได้ไหมค่ะ เนื่องจากในครั้งแรกอาจารย์แนะนำไว้แบบนี้snasui wrote: Mon Nov 19, 2018 9:19 pmถ้าอ่านจากที่แจ้งมา ผิดตรงเอาการ Open ออกครับ หากจะบันทึกข้อมูลลงในไฟล์ต้นทาง เมื่อยังไม่เปิดไฟล์ต้นทางก็ต้องเปิดออกมาก่อน แต่เมื่อเปิดมาแล้วคำสั่งอื่น ๆ หลังจากนั้นไม่ต้องไป Open อีก เมื่อจบงานจึง Close เมื่อจะบันทึกจึงจะ Open ใหม่ เช่นนี้ครับnoona wrote: Mon Nov 19, 2018 3:21 pm ปัญหาในตอนแรกคือ ใช้คำสั่งเปิดไฟล์ด้วยทำให้ฐานข้อมูลเด้งขึ้นมาตอนกดบันทึก ไม่ต้องการให้เด้งขึ้นมาจึงเอาคำสั่ง Open ออก ไม่แน่ใจว่าทำตรงไหนผิด
ค่ะ เข้าใจว่า เปิดมาตอนค้นหาแล้ว พอจะบันทึกไม่ต้องเปิดอีก จึงเอาคำสั่งเปิดออก แต่ติด Error เลยไม่เข้าใจว่าทำผิดตรงไหนค่ะlogic wrote: Tue Nov 20, 2018 11:15 am ไม่ทราบว่างงตรงไหนครับ อาจารย์บอกไว้ว่าถ้าเปิดอยู่แล้วไม่ต้องเปิดขึ้นมาอีก
คือจะทำอะไรก็แล้วแต่ ถ้าไฟล์เปิดอยู่แล้วไม่ต้องสั่งให้เปิดอีก
ลองปรับตามนี้ดูครับnoona wrote: Tue Nov 20, 2018 3:39 pmค่ะ เข้าใจว่า เปิดมาตอนค้นหาแล้ว พอจะบันทึกไม่ต้องเปิดอีก จึงเอาคำสั่งเปิดออก แต่ติด Error เลยไม่เข้าใจว่าทำผิดตรงไหนค่ะlogic wrote: Tue Nov 20, 2018 11:15 am ไม่ทราบว่างงตรงไหนครับ อาจารย์บอกไว้ว่าถ้าเปิดอยู่แล้วไม่ต้องเปิดขึ้นมาอีก
คือจะทำอะไรก็แล้วแต่ ถ้าไฟล์เปิดอยู่แล้วไม่ต้องสั่งให้เปิดอีก
Code: Select all
Private Sub CmdSave_Click()
Dim irow As Integer
Dim msgRepns As Integer
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set wb = Workbooks.Open("C:\Users\THA0753H\Desktop\Data.xlsx")
Set ws = Worksheets("Data")
'find first empty row in database
irow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'Check for Id
If (Me.TxtID.Value) = "" Then
Me.Txtfind.SetFocus
Exit Sub
End If
If Application.CountIf(Range("b:b"), TxtID.Text) > 0 Then
irow = Application.Match(CDbl(TxtID.Text), Range("b:b"), 0)
msgRepns = MsgBox("ต้องการแก้ไขข้อมูล ?", vbYesNo)
Else
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
End If
If msgRepns = vbNo Then
Exit Sub
End If
'copy the data to the database
ws.Cells(irow, 2).Value = Me.TxtID.Value
ws.Cells(irow, 3).Value = Me.listTitle.Value
ws.Cells(irow, 4).Value = Me.txtName.Value
ws.Cells(irow, 5).Value = Me.txtSurename.Value
ws.Cells(irow, 6).Value = Me.liststatus.Value
ws.Cells(irow, 7).Value = Me.txtMobile.Value
Unload Me
'Clear the data
Me.TxtID.Value = ""
Me.listTitle.Value = ""
Me.txtName.Value = ""
Me.txtSurename.Value = ""
Me.liststatus.Value = ""
Me.txtMobile.Value = ""
wb.Close True
MsgBox "บันทึกสำเร็จ"
Application.ScreenUpdating = True
End Sub
puriwutpokin wrote: Tue Nov 20, 2018 4:23 pmลองปรับตามนี้ดูครับnoona wrote: Tue Nov 20, 2018 3:39 pmค่ะ เข้าใจว่า เปิดมาตอนค้นหาแล้ว พอจะบันทึกไม่ต้องเปิดอีก จึงเอาคำสั่งเปิดออก แต่ติด Error เลยไม่เข้าใจว่าทำผิดตรงไหนค่ะlogic wrote: Tue Nov 20, 2018 11:15 am ไม่ทราบว่างงตรงไหนครับ อาจารย์บอกไว้ว่าถ้าเปิดอยู่แล้วไม่ต้องเปิดขึ้นมาอีก
คือจะทำอะไรก็แล้วแต่ ถ้าไฟล์เปิดอยู่แล้วไม่ต้องสั่งให้เปิดอีกCode: Select all
Private Sub CmdSave_Click() Dim irow As Integer Dim msgRepns As Integer Dim wb As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Set wb = Workbooks.Open("C:\Users\THA0753H\Desktop\Data.xlsx") Set ws = Worksheets("Data") 'find first empty row in database irow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row 'Check for Id If (Me.TxtID.Value) = "" Then Me.Txtfind.SetFocus Exit Sub End If If Application.CountIf(Range("b:b"), TxtID.Text) > 0 Then irow = Application.Match(CDbl(TxtID.Text), Range("b:b"), 0) msgRepns = MsgBox("ต้องการแก้ไขข้อมูล ?", vbYesNo) Else irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row End If If msgRepns = vbNo Then Exit Sub End If 'copy the data to the database ws.Cells(irow, 2).Value = Me.TxtID.Value ws.Cells(irow, 3).Value = Me.listTitle.Value ws.Cells(irow, 4).Value = Me.txtName.Value ws.Cells(irow, 5).Value = Me.txtSurename.Value ws.Cells(irow, 6).Value = Me.liststatus.Value ws.Cells(irow, 7).Value = Me.txtMobile.Value Unload Me 'Clear the data Me.TxtID.Value = "" Me.listTitle.Value = "" Me.txtName.Value = "" Me.txtSurename.Value = "" Me.liststatus.Value = "" Me.txtMobile.Value = "" wb.Close True MsgBox "บันทึกสำเร็จ" Application.ScreenUpdating = True End Sub
Code: Select all
Private Sub listtambon1_Change()
Me.listampor1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("D3:G7428"), 2, 0)
End Sub
ปรับตามนี้ครับnoona wrote: Wed Nov 21, 2018 6:27 pmpuriwutpokin wrote: Tue Nov 20, 2018 4:23 pmลองปรับตามนี้ดูครับnoona wrote: Tue Nov 20, 2018 3:39 pm
ค่ะ เข้าใจว่า เปิดมาตอนค้นหาแล้ว พอจะบันทึกไม่ต้องเปิดอีก จึงเอาคำสั่งเปิดออก แต่ติด Error เลยไม่เข้าใจว่าทำผิดตรงไหนค่ะCode: Select all
Private Sub CmdSave_Click() Dim irow As Integer Dim msgRepns As Integer Dim wb As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Set wb = Workbooks.Open("C:\Users\THA0753H\Desktop\Data.xlsx") Set ws = Worksheets("Data") 'find first empty row in database irow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row 'Check for Id If (Me.TxtID.Value) = "" Then Me.Txtfind.SetFocus Exit Sub End If If Application.CountIf(Range("b:b"), TxtID.Text) > 0 Then irow = Application.Match(CDbl(TxtID.Text), Range("b:b"), 0) msgRepns = MsgBox("ต้องการแก้ไขข้อมูล ?", vbYesNo) Else irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row End If If msgRepns = vbNo Then Exit Sub End If 'copy the data to the database ws.Cells(irow, 2).Value = Me.TxtID.Value ws.Cells(irow, 3).Value = Me.listTitle.Value ws.Cells(irow, 4).Value = Me.txtName.Value ws.Cells(irow, 5).Value = Me.txtSurename.Value ws.Cells(irow, 6).Value = Me.liststatus.Value ws.Cells(irow, 7).Value = Me.txtMobile.Value Unload Me 'Clear the data Me.TxtID.Value = "" Me.listTitle.Value = "" Me.txtName.Value = "" Me.txtSurename.Value = "" Me.liststatus.Value = "" Me.txtMobile.Value = "" wb.Close True MsgBox "บันทึกสำเร็จ" Application.ScreenUpdating = True End Sub
ขอบคุณมากนะคะ คำสั่งเดียวได้ตามที่ต้องการเลย
จะรบกวนเพิ่มเติมค่ะ
พอดีต้องการให้เมื่อมีการเปลี่ยนแปลงที่อยู่ ในช่อง แขวง/ตำบล แล้วขึ้น อำเภอ จังหวัด รหัสไปรษณีย์ อัตโนมัติ เลยใช้ Fucntion Vlookup
แต่ติด Error ค่ะ ต้องปรับโค้ดยังไงคะ
Code: Select all
Private Sub listtambon1_Change() Me.listampor1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("D3:G7428"), 2, 0) End Sub
Code: Select all
Private Sub listtambon1_Change()
On Error Resume Next
Me.listampor1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("C3:G7428"), 2, 0)
Me.listprovince1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("C3:G7428"), 3, 0)
Me.Txtcode1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("C3:G7428"), 4, 0)
End Sub
Code: Select all
Private Sub listtambon1_Change()
Me.listampor1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("D3:G7428"), 2, 0)
End Sub
Code: Select all
Private Sub listtambon1_Change()
On Error Resume Next
Me.listampor1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("C3:G7428"), 2, 0)
Me.listprovince1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("C3:G7428"), 3, 0)
Me.Txtcode1 = Application.VLookup(listtambon1.Value, Worksheets("Address").Range("C3:G7428"), 4, 0)
End Sub
Code: Select all
Private Sub listtambon1_Change()
On Error Resume Next
Dim Amphur1 As Range
Dim iStart As Integer
Dim iStop As Integer
With Sheets("Address")
iStart = Application.Match(listtambon1, .Range("C:C"), 0)
iStop = Application.CountIf(.Range("C:C"), listtambon1)
Set Amphur1 = .Range("D" & iStart).Resize(iStop)
End With
listampor1 = ""
listprovince1 = ""
Txtcode1 = ""
listampor1.RowSource = "Address!" & Amphur1.Address
End Sub
Private Sub Userform_Activate()
On Error Resume Next
Dim tambon1 As String
tambon1 = Range("C3:f7428").Address
listtambon1.RowSource = "Address!" & tambon1
End Sub
กรณีข้อมูลไม่อยู่ติดกัน ต้องใช้การ Loop เข้ามาวางใน ListBox จะกำหนด RowSource ซึ่งใช้ข้อมูลที่ติดกัน โดยใช้ Countif เพื่อนับจำนวนในความหมายว่าติดกันกี่จำนวนแล้วกำหนดมาเป็นช่วงเซลล์ใน RowSource เช่นนี้ไม่ได้ครับnoona wrote: Thu Nov 22, 2018 5:57 pm ขอบคุณมากนะคะ รบกวนช่วยแนะนำเพิ่มเติมด้วยค่ะ ไม่ต้องการให้ในช่อง เขต/อำเภอ โชว์ข้อมูลเหมือนกัน จากไฟล์ Sheet Address มีเขตบางมด 2 ที่ แต่คนล่ะเขตกัน แต่จากรูปโชว์เป็น เขตเดียวกัน