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 btsearch_Click()
On Error Resume Next
Dim found As Boolean
Dim r As Range
For Each r In Sheet2.Columns(A).SpecialCells(xlCellTypeConstants)
Sheet2.Activate
Next r
If found Then
If Err.Number = 91 Then
TextBox1.RowSource = "combobox1"
End If
Exit Sub
Else
MsgBox "ไม่มีข้อมูล"
TextBox1.Value = ""
Combobox1.Value = ""
End If
End Sub
snasui wrote: ค่อย ๆ ถามตอบกันไปครับ
จากไฟล์แนบ ComboBox1 ยังเลือกรายการไม่ได้ ช่วยกำหนดให้เลือกได้แล้วแนบไฟล์มาใหม่ครับ
กรณีเลือก ComboBox1 แล้ว ให้แสดงข้อมูลที่ใด แสดงอย่างไร ช่วยอธิบายเพิ่มด้วยครับ
Code: Select all
Private Sub ComboBox1_Change()
If ComboBox1.Value = "Section" Then
ListBox1.RowSource = "DATA!B2:B20"
Else
ListBox1.Value = ""
TextBox1.Value = ""
End If
If ComboBox1.Value = "Uniform_Type" Then
ListBox1.RowSource = "DATA!C2:C20"
Else
ListBox1.Value = ""
TextBox1.Value = ""
End If
If ComboBox1.Value = "Size_Shirth" Then
ListBox1.RowSource = "DATA!G2:G20"
Else
ListBox1.Value = ""
TextBox1.Value = ""
End If
If ComboBox1.Value = "Size_Trousere" Then
ListBox1.RowSource = "DATA!H2:H60"
Else
ListBox1.Value = ""
TextBox1.Value = ""
End If
End Sub
ต้องแก้ไขตรงไหนค่ะlogic wrote:เลือกแล้วให้มันทำอะไรพอจะเข้าใจอยู่ครับ
โค้ดนี้มันใช้เมื่อ ComboBox1 มีการเปลี่ยนแปลงนั่นหมายถึงว่ามันมีค่าให้เลือกก่อน แต่ตอนนี้ค่าที่จะให้เลือกมันยังไม่มีเลยนะครับ
ลองศึกษาคำสั่ง AddItem เข้าคอมโบบ๊อกซ์จากลิ้งค์ด้านล่างครับBenmore wrote:ต้องแก้ไขตรงไหนค่ะ
Userform_Initialize
ของ UserForm2
ถัดจากบรรทัด Call ClearData
ครับDhitiBank wrote:ลองศึกษาคำสั่ง AddItem เข้าคอมโบบ๊อกซ์จากลิ้งค์ด้านล่างครับBenmore wrote:ต้องแก้ไขตรงไหนค่ะ
http://www.ozgrid.com/Excel/add-values- ... -excel.htm
https://msdn.microsoft.com/en-us/vba/ac ... hod-access
โดยเขียนคำสั่งไว้ในโพรซีเยอร์Userform_Initialize
ของUserForm2
ถัดจากบรรทัดCall ClearData
ครับ
Code: Select all
Private Sub ClearData()
TextBox1.Text = vbNullString
TextBox1.SetFocus
End Sub
Private Sub btsearch_Click()
On Error Resume Next
Dim found As Boolean
Dim r As Range
For Each r In Sheet2.Columns(A).SpecialCells(xlCellTypeConstants)
Sheet2.Activate
Next r
If found Then
If Err.Number = 91 Then
TextBox1.RowSource = "combobox1"
End If
Exit Sub
Else
MsgBox "äÁèÁÕ¢éÍÁÙÅ"
TextBox1.Value = ""
Combobox1.Value = ""
End If
End Sub
Private Sub CommandButton1_Click()
Dim CurrentRow As Long
Sheet2.Activate
If TextBox1 <> vbNullString Then
CurrentRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(CurrentRow, 1).Value = TextBox1.Text
Call ClearData
Else
MsgBox ("¡Ãسһé͹¢éÍÁÙÅ")
End If
End Sub
Private Sub CommandButton2_Click()
UserForm2.Hide
End Sub
Private Sub UserForm_Initialize()
Call ClearData
Combobox1.AddItem "Section"
Combobox1.AddItem "Uniform_Type"
Combobox1.AddItem "Size_Shirth"
Combobox1.AddItem "Size_Trousere"
Combobox1.AddItem "Group"
Combobox1.AddItem "Position"
Combobox1.AddItem "DEPT"
Combobox1.AddItem "Uniform_No_F"
Combobox1.AddItem "Uniform_No_M"
End Sub
ลองปรับแล้วค่ะ ก็ยังรันไม่ขึ้นอยู่ดีค่ะlogic wrote:ไม่บอกเสียหน่อยหรือครับว่าทำอะไรไปแล้ว ยังติดเรื่องใด
Code: Select all
nRow = Sheet2.Columns(A).Find(Combobox1.Value).Row
Code: Select all
Private Sub UserForm_Initialize()
Dim r As Range, rTarget As Range
Call ClearData
With Sheets("data")
Set rTarget = .Range(.Range("a1"), .Cells(1, .Columns.Count).End(xlToLeft)) _
.SpecialCells(xlCellTypeVisible)
Set rTarget = rTarget.SpecialCells(xlCellTypeConstants)
End With
For Each r In rTarget
Combobox1.AddItem r.Value
Next r
End Sub
Code: Select all
Private Sub btsearch_Click()
Dim txt As String, r As Range, rList As Range
txt = Combobox1.Value
With Sheets("data")
Set r = .Rows(1).Find(txt)
Set rList = .Range(r.Offset(1, 0), .Cells(.Rows.Count, r.Column).End(xlUp)) _
.SpecialCells(xlCellTypeConstants)
End With
ListBox1.Clear
For Each r In rList
ListBox1.AddItem r.Value
Next r
'If Err.Number = 91 Then
' ListBox1.RowSource = "Combobox1.Value"
' MsgBox "ไม่มีข้อมูล"
'End If
End Sub
Code: Select all
'ADD
Private Sub CommandButton1_Click()
Str_text = Combobox1.Text & " " & TextBox1.Text
With ListBox1
.AddItem Str_text
End With
Dim strFind As String
Dim oRng As Range
Dim fRng As Range
Dim i As Long
strFind = Combobox1.Value ' string to find
Set oRng = Worksheets("DATA").Rows(1) ' column to search
Set fRng = oRng.Cells(oRng.Cells.Count)
For i = 1 To Application.CountIf(oRng, strFind & "*")
Set fRng = oRng.Cells.Find(What:=strFind, _
LookIn:=xlValues, _
LookAt:=xlPart, _
After:=fRng, _
MatchCase:=False)
If Not fRng Is Nothing Then
With ListBox1
.AddItem fRng.Offset(1, 0).Value
MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂ")
Call ClearData
End With
Else
MsgBox ("¡Ãسһé͹¢éÍÁÙÅ")
End If
Next i
End Sub
Code: Select all
'ADD
Private Sub CommandButton1_Click()
Str_text = ComboBox1.Text & " " & TextBox1.Text
With ListBox1
.AddItem Str_text
End With
Dim strFind As String
Dim oRng As Range
Dim fRng As Range
Dim i As Long
strFind = ComboBox1.Value ' string to find
Set oRng = Worksheets("DATA").Rows(1) ' column to search
Set fRng = oRng.Cells(oRng.Cells.Count)
For i = 1 To Application.CountIf(oRng, strFind & "*")
Set fRng = oRng.Cells.Find(What:=strFind, _
LookIn:=xlValues, _
LookAt:=xlPart, _
After:=fRng, _
MatchCase:=False)
If Not fRng Is Nothing Then
With ListBox1
.AddItem fRng.Offset(1, 0).Value
MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂ")
Call ClearData
End With
Else
MsgBox ("¡Ãسһé͹¢éÍÁÙÅ")
End If
Next i
End Sub
รบกวนตรวจสอบโค้ดให้หน่อยค่ะBenmore wrote:รบกวนดูโค้ดให้หน่อยค่ะ ถ้าต้องการ add ข้อมูลตามที่เลือกหัวข้อใน combobox ต้องเพิ่มโค้ดตรงไหนเข้าไปบ้างค่ะCode: Select all
'ADD Private Sub CommandButton1_Click() Str_text = ComboBox1.Text & " " & TextBox1.Text With ListBox1 .AddItem Str_text End With Dim strFind As String Dim oRng As Range Dim fRng As Range Dim i As Long strFind = ComboBox1.Value ' string to find Set oRng = Worksheets("DATA").Rows(1) ' column to search Set fRng = oRng.Cells(oRng.Cells.Count) For i = 1 To Application.CountIf(oRng, strFind & "*") Set fRng = oRng.Cells.Find(What:=strFind, _ LookIn:=xlValues, _ LookAt:=xlPart, _ After:=fRng, _ MatchCase:=False) If Not fRng Is Nothing Then With ListBox1 .AddItem fRng.Offset(1, 0).Value MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂ") Call ClearData End With Else MsgBox ("¡Ãسһé͹¢éÍÁÙÅ") End If Next i End Sub
ตัวอย่าง ต้องการ add ข้อมูล Uniform_Type เพิ่ม รองเท้า เข้าไปในคอลลัมน์ Uniform_Type ในชีท DATA พร้อมแสดงใน listbox ด้วยค่ะ
Code: Select all
'ADD
Private Sub CommandButton1_Click()
' Str_text = Combobox1.Text & " " & TextBox1.Text
' With ListBox1
' .AddItem Str_text
' End With
Dim strFind As String
Dim oRng As Range
Dim fRng As Range
Dim i As Long
strFind = Combobox1.Value ' string to find
Set oRng = Worksheets("DATA").Rows(1) ' column to search
Set fRng = oRng.Cells(oRng.Cells.Count)
For i = 1 To Application.CountIf(oRng, strFind & "*")
Set fRng = oRng.Cells.Find(What:=strFind, _
LookIn:=xlValues, _
LookAt:=xlPart, _
After:=fRng, _
MatchCase:=False)
If Not fRng Is Nothing Then
fRng.End(xlDown).Offset(1, 0).Value = Me.TextBox1.Text
With ListBox1
.AddItem Me.TextBox1.Text 'fRng.Offset(1, 0).Value
MsgBox ("บันทึกข้อมูลเรียบร้อย")
Call ClearData
End With
Else
MsgBox ("กรุณาป้อนข้อมูล")
End If
Next i
End Sub
Code: Select all
Private Sub CommandButton3_Click()
Dim lng As Long
Answer = MsgBox("Are you sure you want to delete data from database?", 4 + 48, "Delete database")
If Answer = 6 Then
lng = Application.Match(ListBox1.Value, Worksheets("DATA").Range("E:E"), 0)
Worksheets("DATA").Rows(lng).Delete
Unload Me
ElseIf Answer = 7 Then
End If
End Sub
Code: Select all
Dim lng As Long
Dim i As Long, j As Long
With Sheets("DATA")
If Application.CountIf(.Rows(1), Me.Combobox1.Text) = 0 Then
Exit Sub
Else
j = Application.Match(Me.Combobox1.Text, .Rows(1), 0)
End If
End With
i = Me.ListBox1.ListIndex
Answer = MsgBox("Are you sure you want to delete data from database?", 4 + 48, "Delete database")
If Answer = 6 Then
If i <> -1 Then
lng = Application.Match(Me.ListBox1.List(i), Sheets("DATA").Columns(j), 0)
Worksheets("DATA").Cells(lng, j).Delete
Me.ListBox1.RemoveItem Me.ListBox1.ListIndex
Unload Me
End If
End If