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: ไฟล์ที่แนบมายังไม่มีการปรับ Code ที่ผมตอบไปด้านบน ปรับมาก่อนแล้วแนบมาใหม่ครับ
Code: Select all
For Each ct In Me.Frame2.Controls
If VBA.Left(ct.Name, 3) = "Opt" And ct.Value = True Then
Debug.Print ct.Name
Cells(emptyRow, 7).Value = ct.Caption
Exit For
End If
Next ct
For Each ct In Me.Frame5.Controls
If VBA.Left(ct.Name, 4) = "Opt" And ct.Value = True Then
Debug.Print ct.Name
Cells(emptyRow, 8).Value = ct.Caption
Exit For
End If
Next ct
Code: Select all
Private Sub btsave_Click()
On Error Resume Next
If TextBox1 = "" Or TextBox3 = "" Then
MsgBox "¡ÃسҡÃÍ¡¢éÍÁÙÅãËé¤Ãº¶éǹ"
Exit Sub
End If
Dim emptyRow As Integer
Dim ct As Object
Dim strTb1 As Variant
Dim strTb3 As Variant
Sheet9.Activate
emptyRow = WorksheetFunction.CountA(Sheet9.Range("A3:A10000")) + 1
For Each ct In Me.Frame2.Controls
If VBA.Left(ct.Name, 3) = "Opt" And ct.Value = True Then
Cells(emptyRow, 7).Value = ct.Caption
Exit For
End If
Next ct
For Each ct In Me.Frame5.Controls
'Other code
Code: Select all
Private Sub btsave_Click()
'On Error Resume Next
If TextBox1 = "" Or TextBox3 = "" Then
MsgBox "¡ÃسҡÃÍ¡¢éÍÁÙÅãËé¤Ãº¶éǹ"
Exit Sub
End If
Dim emptyRow As Integer
Dim ct As Object
Dim strTb1 As Variant
Dim strTb3 As Variant
Sheet9.Activate
emptyRow = WorksheetFunction.CountA(Sheet9.Range("A3:A10000")) + 1
For Each ct In Me.Frame2.Controls
If VBA.Left(ct.Name, 3) = "Opt" And ct.Value = True Then
Cells(emptyRow, 7).Value = ct.Caption
Exit For
End If
Next ct
For Each ct In Me.Frame5.Controls
If VBA.Left(ct.Name, 4) = "Opt" And ct.Value = True Then
Debug.Print ct.Name
Cells(emptyRow, 8).Value = ct.Caption
Exit For
End If
Next ct
emptyRow = WorksheetFunction.CountA(Sheet9.Range("A3:A10000")) + 1
'emptyRow = WorksheetFunction.Count("A3:A10000") + 1
If emptyRow = 0 Then
emptyRow = 2
Else
emptyRow = emptyRow + 2
Sheet9.Activate
strTb1 = Split(TextBox1.Text, vbCrLf)
strTb3 = TextBox3.Text & vbCrLf
strTb3 = strTb3 & vbCrLf
strTb3 = strTb3 & vbCrLf
strTb3 = Split(strTb3, vbCrLf)
Cells(emptyRow, 1).Value = VBA.Mid(strTb1(0), InStr(strTb1(0), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 2).Value = VBA.Mid(strTb1(1), InStr(strTb1(1), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 3).Value = VBA.Mid(strTb1(2), InStr(strTb1(2), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 4).Value = VBA.Mid(strTb1(3), InStr(strTb1(3), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 6).Value = strTb3(0) & "," & strTb3(1) & "," & strTb3(2) & vbCrLf & strTb3(3) & "," & strTb3(4) & "," & strTb3(5) 'TextBox3.Value
'Cells(emptyRow, 7).Value = OptionButton
Cells(emptyRow, 5).Value = comday.Value & "/" & commonth.Value & "/" & comyear.Value
MsgBox "ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂáÅéÇ"
Unload Me
UserForm1.Show
End If
'Sheet1.Activate
End Sub
Code: Select all
'Save
Private Sub btsave_Click()
On Error Resume Next
If TextBox1 = "" Or TextBox3 = "" Then
MsgBox "¡ÃسҡÃÍ¡¢éÍÁÙÅãËé¤Ãº¶éǹ"
Exit Sub
End If
Dim emptyRow As Integer
Dim ct As Object
Dim strTb1 As Variant
Dim strTb3 As Variant
For Each ct In Me.Frame2.Controls
If VBA.Left(ct.Name, 3) = "Opt" And ct.Value = True Then
Debug.Print ct.Name
Cells(emptyRow, 7).Value = ct.Caption
Exit For
End If
Next ct
For Each ct In Me.Frame5.Controls
If VBA.Left(ct.Name, 4) = "Opt" And ct.Value = True Then
Debug.Print ct.Name
Cells(emptyRow, 8).Value = ct.Caption
Exit For
End If
Next ct
emptyRow = WorksheetFunction.CountA(Sheet9.Range("A3:A10000")) + 1
'emptyRow = WorksheetFunction.Count("A3:A10000") + 1
If emptyRow = 0 Then
emptyRow = 2
Else
emptyRow = emptyRow + 2
Sheet9.Activate
strTb1 = Split(TextBox1.Text, vbCrLf)
strTb3 = TextBox3.Text & vbCrLf
strTb3 = strTb3 & vbCrLf
strTb3 = strTb3 & vbCrLf
strTb3 = Split(strTb3, vbCrLf)
Cells(emptyRow, 1).Value = VBA.Mid(strTb1(0), InStr(strTb1(0), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 2).Value = VBA.Mid(strTb1(1), InStr(strTb1(1), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 3).Value = VBA.Mid(strTb1(2), InStr(strTb1(2), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 4).Value = VBA.Mid(strTb1(3), InStr(strTb1(3), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 6).Value = strTb3(0) & "," & strTb3(1) & "," & strTb3(2) & vbCrLf & strTb3(3) & "," & strTb3(4) & "," & strTb3(5) 'TextBox3.Value
'Cells(emptyRow, 7).Value = OptionButton
Cells(emptyRow, 5).Value = comday.Value & "/" & commonth.Value & "/" & comyear.Value
MsgBox "ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂáÅéÇ"
Unload Me
UserForm1.Show
End If
Sheet1.Activate
End Sub
Code ที่แนบมาไม่เป็นไปตามที่ผมตอบไปตามโพสต์ #26 ตามที่ยกมาด้านล่างนี้ครับBenmore wrote:ไฟล์แนบที่แก้ไขโค้ดแล้วรันไม่ได้ตามที่ต้องการค่ะCode: Select all
'Save Private Sub btsave_Click() On Error Resume Next If TextBox1 = "" Or TextBox3 = "" Then MsgBox "¡ÃسҡÃÍ¡¢éÍÁÙÅãËé¤Ãº¶éǹ" Exit Sub End If Dim emptyRow As Integer Dim ct As Object Dim strTb1 As Variant Dim strTb3 As Variant For Each ct In Me.Frame2.Controls If VBA.Left(ct.Name, 3) = "Opt" And ct.Value = True Then Debug.Print ct.Name Cells(emptyRow, 7).Value = ct.Caption Exit For End If Next ct For Each ct In Me.Frame5.Controls If VBA.Left(ct.Name, 4) = "Opt" And ct.Value = True Then Debug.Print ct.Name Cells(emptyRow, 8).Value = ct.Caption Exit For End If Next ct emptyRow = WorksheetFunction.CountA(Sheet9.Range("A3:A10000")) + 1 'emptyRow = WorksheetFunction.Count("A3:A10000") + 1 If emptyRow = 0 Then emptyRow = 2 Else emptyRow = emptyRow + 2 Sheet9.Activate strTb1 = Split(TextBox1.Text, vbCrLf) strTb3 = TextBox3.Text & vbCrLf strTb3 = strTb3 & vbCrLf strTb3 = strTb3 & vbCrLf strTb3 = Split(strTb3, vbCrLf) Cells(emptyRow, 1).Value = VBA.Mid(strTb1(0), InStr(strTb1(0), ":") + 1) 'TextBox1.Value Cells(emptyRow, 2).Value = VBA.Mid(strTb1(1), InStr(strTb1(1), ":") + 1) 'TextBox1.Value Cells(emptyRow, 3).Value = VBA.Mid(strTb1(2), InStr(strTb1(2), ":") + 1) 'TextBox1.Value Cells(emptyRow, 4).Value = VBA.Mid(strTb1(3), InStr(strTb1(3), ":") + 1) 'TextBox1.Value Cells(emptyRow, 6).Value = strTb3(0) & "," & strTb3(1) & "," & strTb3(2) & vbCrLf & strTb3(3) & "," & strTb3(4) & "," & strTb3(5) 'TextBox3.Value 'Cells(emptyRow, 7).Value = OptionButton Cells(emptyRow, 5).Value = comday.Value & "/" & commonth.Value & "/" & comyear.Value MsgBox "ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂáÅéÇ" Unload Me UserForm1.Show End If Sheet1.Activate End Sub
snasui wrote: เรียงลำดับ Code ไม่ถูกต้องครับ
ตัวอย่างการเรียงลำดับ Code ควรจะเป็นด้านล่าง
สังเกตตัวแปรที่จะกำหนดค่าบรรทัดจะต้องกำหนดเอาไว้ก่อนที่จะนำข้อมูลไปวางCode: Select all
Private Sub btsave_Click() On Error Resume Next If TextBox1 = "" Or TextBox3 = "" Then MsgBox "¡ÃسҡÃÍ¡¢éÍÁÙÅãËé¤Ãº¶éǹ" Exit Sub End If Dim emptyRow As Integer Dim ct As Object Dim strTb1 As Variant Dim strTb3 As Variant Sheet9.Activate emptyRow = WorksheetFunction.CountA(Sheet9.Range("A3:A10000")) + 1 For Each ct In Me.Frame2.Controls If VBA.Left(ct.Name, 3) = "Opt" And ct.Value = True Then Cells(emptyRow, 7).Value = ct.Caption Exit For End If Next ct For Each ct In Me.Frame5.Controls 'Other code
ควรจะเอา On Error Resume Next ออกเสียก่อนแล้วทำการ Debug จะได้ทราบได้เองเบื้องต้นว่าผิดพลาดหรือไม่อย่างไรครับ
Code: Select all
Private Sub btsearch1_Click()
On Error Resume Next
Dim found As Boolean
Dim txt As String
Dim r As Range
Dim chkDate As Date
Dim nRow As String
chkDate = DateSerial(cmyear, cmmonth.ListIndex + 1, cmday)
Sheet9.Activate
For Each r In Sheet9.Columns(1).SpecialCells(xlCellTypeConstants)
If Right(r.Value, 3) = Right(txtsearch1.Text, 3) Or r.Offset(0, 4).Value2 = CLng(chkDate) Then
nRow = r.Row
found = True
Exit For
End If
Next r
If found Then
If Not IsNumeric(VBA.Right(txtsearch1.Text, 3)) Then
MsgBox "¡ÃسÒãÊè¢éÍÁÙÅà»ç¹µÑÇàÅ¢"
Exit Sub
End If
If Err.Number = 91 Then
TextBox1.RowSource = "txtsearch1.Text"
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
TextBox11.Value = ""
TextBox16.Value = ""
TextBox17.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
'MsgBox "äÁèÁÕ¢éÍÁÙÅ"
End If
TextBox7.Value = Cells(nRow, 1)
TextBox8.Value = Cells(nRow, 2)
TextBox9.Value = Cells(nRow, 3)
TextBox10.Value = Cells(nRow, 4)
TextBox11.Value = Cells(nRow, 6)
TextBox16.Value = Cells(nRow, 7)
TextBox17.Value = Cells(nRow, 8)
TextBox12.Value = Cells(nRow, 9)
TextBox13.Value = Cells(nRow, 10)
Exit Sub
Else
MsgBox "äÁèÁÕ¢éÍÁÙÅ"
End If
Sheet1.Activate
End Sub
Code: Select all
Private Sub btsave_Click()
'On Error Resume Next
If TextBox1 = "" Or TextBox3 = "" Then
MsgBox "กรุณากรอกข้อมูลให้ครบถ้วน"
Exit Sub
End If
Dim emptyRow As Integer
Dim ct As Object
Dim strTb1 As Variant
Dim strTb3 As Variant
opt = OptionButton1.Value Or OptionButton2.Value
emptyRow = WorksheetFunction.CountA(Sheet9.Range("A3:A10000")) + 1
'emptyRow = WorksheetFunction.Count("A3:A10000") + 1
If emptyRow = 0 Then
emptyRow = 2
Else
emptyRow = emptyRow + 2
Sheet9.Activate
strTb1 = Split(TextBox1.Text, vbCrLf)
strTb3 = TextBox3.Text & vbCrLf
strTb3 = strTb3 & vbCrLf
strTb3 = strTb3 & vbCrLf
strTb3 = Split(strTb3, vbCrLf)
Cells(emptyRow, 1).Value = VBA.Mid(strTb1(0), InStr(strTb1(0), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 2).Value = VBA.Mid(strTb1(1), InStr(strTb1(1), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 3).Value = VBA.Mid(strTb1(2), InStr(strTb1(2), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 4).Value = VBA.Mid(strTb1(3), InStr(strTb1(3), ":") + 1) 'TextBox1.Value
Cells(emptyRow, 6).Value = strTb3(0) & "," & strTb3(1) & "," & strTb3(2) 'TextBox3.Value
Cells(emptyRow, 7).Value = strTb3(3) & "," & strTb3(4) & "," & strTb3(5)
Cells(emptyRow, 8).Value = strTb3(6) & "," & strTb3(7)
If OptionButton1.Value = True Then
Cells(CurrentRow, 10).Value = "มารับแล้ว"
ElseIf OptionButton2.Value = True Then
Cells(CurrentRow, 10).Value = "ไม่ได้มารับ"
ElseIf OptionButton3.Value = True Then
Cells(CurrentRow, 10).Value = TextBox15.Value
End If
If OptionButton4.Value = True Then
Cells(CurrentRow, 9).Value = "ชุดหดและเก่าตามสภาพ"
ElseIf OptionButton5.Value = True Then
Cells(CurrentRow, 9).Value = "ชุดเปื่อยขาด เนื่องจากการซัก"
ElseIf OptionButton6.Value = True Then
Cells(CurrentRow, 9).Value = "ชุดขาดตามรอยตะเข็บ"
ElseIf OptionButton7.Value = True Then
Cells(CurrentRow, 9).Value = "เดินทางไปต่างจังหวัด/ต่างประเทศ"
ElseIf OptionButton8.Value = True Then
Cells(CurrentRow, 9).Value = TextBox2.Value
End If
Cells(emptyRow, 5).Value = comday.Value & "/" & commonth.Value & "/" & comyear.Value
MsgBox "บันทึกข้อมูลเรียบร้อยแล้ว"
Unload Me
UserForm1.Show
End If
'Sheet1.Activate
End Sub
การให้กรอกวันที่เองมีความยุ่งยากในการตรวจสอบเพราะสามารถจะคีย์เป็นตัวเลขวันแล้วตามด้วยเดือนเป็นข้อความ หากแยกช่องเป็น วัน เดือน ปี แล้วเช็คแต่ละช่องว่าเป็นไปตามที่กำหนดหรือไม่จะง่ายกว่าครับBenmore wrote:ทำได้แล้วขอบคุณมากกกกกกกกกกกกกกกค่ะ
สอบถามเพิ่มเติมค่ะ ถ้าต้องการให้ textbox กรอกข้อมูลได้เฉพาะวันทีีต้องเขียนโค้ดแบบไหนค่ะ
Userform2 ตรงเฟรมสถานะในการส่งซ่อมค่ะ
Benmore wrote:
Code: Select all
Private Sub CommandButton6_Click()
Dim id As String
Dim rowselect As String
If TextBox7.Text = "" Then
MsgBox ("กรุณาเลือกข้อมูล")
Else
id = TextBox7.Text
rowselect = WorksheetFunction.Match(id, Sheet6.Range("A1:A300"), 0)
Rows(rowselect).Select
Rows(rowselect).EntireRow.Delete
End If
Unload Me
UserForm1.Show
End Sub
rowselect = WorksheetFunction.Match(id, Sheet9.Range("A1:A300"), 0)