Page 1 of 1

ต้องการเพิ่มช่องค้นหา อีก 2 ช่อง VBA

Posted: Thu Oct 08, 2015 9:57 pm
by buncha2522
รบกวนผู้มีพระคุณชี้แนะเรื่องเพิ่ม code ในการค้นหาอีก 2 ช่อง ผมไม่มีความรู้เรื่องนี้ครับ รบกวนช่วยเหลือหน่อยครับ

Option Explicit

Public Sub search_quotation()

Dim quotation_search As String
Dim search_row As Single
Dim quotation_no As String

Dim i As Integer
Dim c As Integer

Const quotation_sheet = "Quotation"
Const quotation_db_sheet = "db_quotation"

Const q_no_col = 1
Const q_date_col = 2

Const q_customercode_col = 3
Const q_contactperson_col = 4
Const q_customeraddr_col = 5

Dim q_item_details_col(1 To 10) As Byte
Dim q_item_amount_col(1 To 10) As Byte
Dim q_item_price_col(1 To 10) As Byte

Const item_details_range = "c"
Const item_amount_range = "d"
Const item_price_range = "e"

'************************************************************************************************

quotation_search = Worksheets(quotation_sheet).quotation_no_txtbox.Value

search_row = 2
quotation_no = Worksheets(quotation_db_sheet).Cells(search_row, q_no_col).Value

Do Until quotation_no = quotation_search

search_row = search_row + 1
quotation_no = Worksheets(quotation_db_sheet).Cells(search_row, q_no_col).Value

Loop

With Worksheets(quotation_sheet)

.Range("f8").Value = Worksheets(quotation_db_sheet).Cells(search_row, q_no_col).Value
.Range("f9").Value = Worksheets(quotation_db_sheet).Cells(search_row, q_date_col).Value
.Range("f10").Value = Worksheets(quotation_db_sheet).Cells(search_row, q_customercode_col).Value


.Range("c12").Value = Worksheets(quotation_db_sheet).Cells(search_row, q_contactperson_col).Value
.Range("c13").Value = Worksheets(quotation_db_sheet).Cells(search_row, q_customeraddr_col).Value


q_item_details_col(1) = 6
q_item_amount_col(1) = 7
q_item_price_col(1) = 8

i = 1
For i = 2 To 10

q_item_details_col(i) = q_item_details_col(i - 1) + 3
q_item_amount_col(i) = q_item_amount_col(i - 1) + 3
q_item_price_col(i) = q_item_price_col(i - 1) + 3

Next i


i = 1
c = 1
For i = 17 To 26

.Range(item_details_range & i).Value = Worksheets(quotation_db_sheet).Cells(search_row, q_item_details_col(c)).Value
.Range(item_amount_range & i).Value = Worksheets(quotation_db_sheet).Cells(search_row, q_item_amount_col(c)).Value
.Range(item_price_range & i).Value = Worksheets(quotation_db_sheet).Cells(search_row, q_item_price_col(c)).Value

c = c + 1

Next i



End With

End Sub

Public Sub search_invoice()

Dim invoice_search As String
Dim search_row As Single
Dim invoice_no As String

Dim i As Integer
Dim c As Integer

Const invoice_sheet = "invoice"
Const invoice_db_sheet = "db_invoice"

Const i_no_col = 1
Const i_date_col = 2

Const i_customercode_col = 3
Const i_contactperson_col = 4
Const i_customeraddr_col = 5

Dim i_item_details_col(1 To 10) As Byte
Dim i_item_amount_col(1 To 10) As Byte
Dim i_item_price_col(1 To 10) As Byte

Const item_details_range = "c"
Const item_amount_range = "d"
Const item_price_range = "e"
Const item_price_range = "f"

'************************************************************************************************

invoice_search = Worksheets(invoice_sheet).invoice_no_txtbox.Value

search_row = 2
invoice_no = Worksheets(invoice_db_sheet).Cells(search_row, i_no_col).Value

Do Until invoice_no = invoice_search

search_row = search_row + 1
invoice_no = Worksheets(invoice_db_sheet).Cells(search_row, i_no_col).Value

Loop

With Worksheets(invoice_sheet)

.Range("f8").Value = Worksheets(invoice_db_sheet).Cells(search_row, i_no_col).Value
.Range("f9").Value = Worksheets(invoice_db_sheet).Cells(search_row, i_date_col).Value
.Range("f10").Value = Worksheets(invoice_db_sheet).Cells(search_row, i_customercode_col).Value
.Range("f11").Value = Worksheets(invoice_db_sheet).Cells(search_row, i_INV_col).Value

.Range("c12").Value = Worksheets(invoice_db_sheet).Cells(search_row, i_contactperson_col).Value
.Range("c13").Value = Worksheets(invoice_db_sheet).Cells(search_row, i_customeraddr_col).Value


i_item_details_col(1) = 6
i_item_amount_col(1) = 7
i_item_price_col(1) = 8

i = 1
For i = 2 To 10

i_item_details_col(i) = i_item_details_col(i - 1) + 3
i_item_amount_col(i) = i_item_amount_col(i - 1) + 3
i_item_price_col(i) = i_item_price_col(i - 1) + 3

Next i


i = 1
c = 1
For i = 17 To 26

.Range(item_details_range & i).Value = Worksheets(invoice_db_sheet).Cells(search_row, i_item_details_col(c)).Value
.Range(item_amount_range & i).Value = Worksheets(invoice_db_sheet).Cells(search_row, i_item_amount_col(c)).Value
.Range(item_price_range & i).Value = Worksheets(invoice_db_sheet).Cells(search_row, i_item_price_col(c)).Value

c = c + 1

Next i



End With

End Sub

Re: ต้องการเพิ่มช่องค้นหา อีก 2 ช่อง VBA

Posted: Thu Oct 08, 2015 9:58 pm
by buncha2522
ขนาดไฟล์ใหญ่จะแนบอย่างไรครับ

Re: ต้องการเพิ่มช่องค้นหา อีก 2 ช่อง VBA

Posted: Fri Oct 09, 2015 12:20 am
by DhitiBank
ขนาดไฟล์ต้องไม่เกิน 300 kb ครับ

เพื่อให้ไฟล์เล็กลง ก็อาจต้องลบข้อมูลออกไปบ้าง เช่น รูปภาพ (หากมี) ข้อมูลให้เหลือแค่ตัวอย่างที่พออธิบายได้ว่า ต้องการทำอะไรแต่ติดปัญหาอะไรครับ นอกจากนี้ยังสามารถบันทึกไฟล์เป็นสกุล xlsb และอาจบีบอัดด้วยโปรแกรมพวก WinZip, WinRAR, 7Zip หรืออื่นๆ ได้ด้วยครับ

แล้วก็ควรโพสต์ code ให้อยู่ในรูปแบบ code เพื่อจะอ่านง่ายและคัดลอกเอาไปทดสอบได้ง่ายครับ อ่านกฎและวิธีการทำที่กฎบอร์ดข้อ 5 ด้านบนครับ