Page 2 of 2
Re: สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ
Posted: Thu Dec 07, 2017 12:08 pm
by arampong
ตอบ จากคุณ eyepop99 ถูกครับผม
ขอบคุณครับ
Re: สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ
Posted: Thu Dec 07, 2017 4:01 pm
by eyepop99
โค๊ดที่แน๊บผมปรับเป็น function เพื่อใช้ run แทนการใช้ worksheetchange นะครับ
ปรับโค๊ด เป็น
จากที่ลอง code ใช้งานได้ตามต้องการแล้วนะครับ
ส่วนการลบข้อมูลเก่าออก และ ความต้องการอื่นๆ ค่อยสอบถามกันต่อไปครับ
Code: Select all
Sub runfn()
Dim rsall As Range, rs As Range
Dim rtall_set As Range, rt_set As Range
Dim rtall_pc As Range, rt_pc As Range
Dim sum_set As Integer
Dim sum_all As Integer
With Sheets("Sheet2")
Set rsall = .Range("H3", .Range("H15")) ' look up value
End With
With Sheets("Sheet1")
Set rtall_set = .Range("B10", .Range("B15")) ' data for lookup
Set rtall_pc = .Range("B3", .Range("B9"))
End With
sum_set = 0
sum_all = 0
For Each rt_set In rtall_set 'sheet2
For Each rs In rsall 'sheet1
If (rt_set.Value) = (rs.Value) And sum_set < 10 Then
rs.Offset(0, 2).Value = rt_set.Offset(0, 2).Value ' (data sheet1 lookup sheet2 คอลัมH ไปทางขวา 2 ช่องหรือที่คอลั่ม J)
With Sheets("sheet2")
sum_set = WorksheetFunction.Sum(.Range("J10:J15"))
End With
ElseIf (rt_set.Value) = (rs.Value) Then
rs.Offset(0, -3).Value = rt_set.Offset(0, 2).Value
End If
Next rs
Next rt_set
With Sheets("sheet2")
sum_all = WorksheetFunction.Sum(.Range("J3:J15"))
End With
For Each rt_pc In rtall_pc
For Each rs In rsall
If (rt_pc.Value) = (rs.Value) And sum_all < 10 Then
rs.Offset(0, 2).Value = rt_pc.Offset(0, 2).Value
With Sheets("sheet2")
sum_all = WorksheetFunction.Sum(.Range("J3:J15"))
End With
ElseIf (rt_pc.Value) = (rs.Value) Then
rs.Offset(0, -3).Value = rt_pc.Offset(0, 2).Value
End If
Next rs
Next rt_pc
Sheets("sheet2").Select
End Sub
Re: สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ
Posted: Thu Dec 07, 2017 4:54 pm
by arampong
ขอขอบคุณอาจารย์มากครับ
จากการทดสอบ โดยการสร้างปุ่มรับค่า Function แทน ผลได้ครับตามอาจารย์แนะนำ
แต่ผมลองเอาไปใช้ ใช้ worksheetchange มันแปลกๆอยู่ครับ
ยังไงแล้วผมจะลองเปลี่ยนมาเป็นแบบ Function ก่อนตามอาจารย์เพื่อทำส่วนต่อไปดูครับ
ขอขอบคุณอาจารย์และทุกๆท่านอย่างสูง ที่ทำให้งาน VBA Excel ครั้งแรกของผมใกล้ความจริงแล้วครับ
ยังไงหากเสร็จแล้ว หรือติดส่วนต่อไปจะกลับมาโพสต์ต่อ หรือแจ้งจบงานครับ
ขอบคุณครับ
Re: สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ
Posted: Thu Dec 07, 2017 5:04 pm
by eyepop99
จากตัว VBA ที่เขียนขึ้น
ถ้าใช้ worksheet change ทุกๆ ครั้งที่ range เปลี่ยน จะเกิดการคำนวนและการส่งค่า
ใส่ 10 เท่ากับรัน โปรแกรม 10 ครั้งซึ่งอาจจะทำให้เกิดความล้าช้า ได้ครับ
เหตุผลว่าทำไมถึงมีการ ใช้ Function แทน
Re: สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ
Posted: Sat Dec 09, 2017 8:58 am
by arampong
จบงานแล้วครับ
ขอบคุณอาจารย์ eyepop99 และท่านอื่นๆด้วยครับ
ได้ลองเขียน worksheet change มีผลจริงๆเมื่อข้อมูลในการประมวลผลเยอะขึ้นครับ
จึงเปลี่ยนมาทำตามอาจารย์ eyepop99 ครับ
ผมไม่โพสต์ ตัวที่เลร็จแล้วน่ะครับ เพราะได้ทำตามอาจารย์ eyepop99 ทุกอย่างเลย
แค่เพื่มในส่วนของตารางมาหลายๆ ตารางเท่านั้นครับ แล้วค่อยสั่ง Run Macro ทีเดียวพร้อมกัน
ขอบคุณมากครับ
Re: สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ
Posted: Fri Jan 26, 2018 3:46 pm
by arampong
เรียนอาจารย์ ติดครับเรื่องตัวเลขตอนโยนค่าครับ
พอผมเปลี่ยนเป็นเลข 4 ทั้งระบบแล้วให้มันโยนค่าข้ามมาได้ 4,4,4 ทั้งๆที่บอกค่าห้ามเกิน 10 ครับ
ผมจะทำดัก Code ยังไงครับ และอีกอย่างถ้าจะให้มันเอามาแค่ 2 หรือไปหาช่องอื่นก่อนว่ามีค่าไหนที่มาบวกแล้วเท่ากับ 10 อยู่่ให้เอามารวมก่อน
ผมจะทำได้อย่างไรครับ
มาตายตอนจบ ฮ่าๆๆ ขอบคุณอีกครังครับ
Re: สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ
Posted: Fri Jan 26, 2018 4:23 pm
by eyepop99
arampong wrote: Fri Jan 26, 2018 3:46 pm
เรียนอาจารย์ ติดครับเรื่องตัวเลขตอนโยนค่าครับ
พอผมเปลี่ยนเป็นเลข 4 ทั้งระบบแล้วให้มันโยนค่าข้ามมาได้ 4,4,4 ทั้งๆที่บอกค่าห้ามเกิน 10 ครับ
ผมจะทำดัก Code ยังไงครับ และอีกอย่างถ้าจะให้มันเอามาแค่ 2 หรือไปหาช่องอื่นก่อนว่ามีค่าไหนที่มาบวกแล้วเท่ากับ 10 อยู่่ให้เอามารวมก่อน
ผมจะทำได้อย่างไรครับ
มาตายตอนจบ ฮ่าๆๆ ขอบคุณอีกครังครับ
ลองปรับตามนี้ครับ
ปล. ตามที่ปรับแก้ จะไม่สามารถเลือกตัวที่ได้ 10 พอดีมา เช่น เติม 1 แล้วเท่ากับ 9 จะไม่หยิบ2มาเติมจนครบ10 ถึงแม้ว่า มี 2 อยู่ก็ตามแต่ถ้ามี 1 อีก1ตัวจะหยิบ 1 มาใส่จนครบ10 ( ถ้าตัวเลข 1 อยู่ก่อน 2 และผลรวมได้ 9 พอดี )
Code: Select all
Sub Button()
Dim rsall As Range, rs As Range
Dim rtall_set As Range, rt_set As Range
Dim rtall_pc As Range, rt_pc As Range
Dim sum_set As Integer
Dim sum_all As Integer
With Sheets("Sheet2")
Set rsall = .Range("H3", .Range("H15")) ' look up value
End With
With Sheets("Sheet1")
Set rtall_set = .Range("B10", .Range("B15")) ' data for lookup
Set rtall_pc = .Range("B3", .Range("B9"))
End With
sum_set = 0
sum_all = 0
For Each rt_set In rtall_set 'sheet2
For Each rs In rsall 'sheet1
With Sheets("sheet2")
sum_set = WorksheetFunction.Sum(.Range("J10:J15"))
End With
If (rt_set.Value) = (rs.Value) And sum_set < 10 And rt_set.Offset(0, 2).Value + sum_set <= 10 Then
rs.Offset(0, 2).Value = rt_set.Offset(0, 2).Value ' (data sheet1 lookup sheet2 ?????H ???????? 2 ????????????????? J)
With Sheets("sheet2")
sum_set = WorksheetFunction.Sum(.Range("J10:J15"))
End With
ElseIf (rt_set.Value) = (rs.Value) Then
rs.Offset(0, -3).Value = rt_set.Offset(0, 2).Value
End If
Next rs
Next rt_set
For Each rt_pc In rtall_pc
For Each rs In rsall
With Sheets("sheet2")
sum_all = WorksheetFunction.Sum(.Range("J3:J15"))
End With
If (rt_pc.Value) = (rs.Value) And sum_all < 10 And sum_all + rt_pc.Offset(0, 2).Value <= 10 Then
rs.Offset(0, 2).Value = rt_pc.Offset(0, 2).Value
With Sheets("sheet2")
sum_all = WorksheetFunction.Sum(.Range("J3:J15"))
End With
ElseIf (rt_pc.Value) = (rs.Value) Then
rs.Offset(0, -3).Value = rt_pc.Offset(0, 2).Value
End If
Next rs
Next rt_pc
Sheets("sheet2").Select
End Sub