สอบถาม VBA ส่งข้อมูลข้าม sheet แบบมีเงื่อนไขครับ

[arampong]

ตอบ จากคุณ eyepop99 ถูกครับผม
ขอบคุณครับ

[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

[arampong]

ขอขอบคุณอาจารย์มากครับ
จากการทดสอบ โดยการสร้างปุ่มรับค่า Function แทน ผลได้ครับตามอาจารย์แนะนำ
แต่ผมลองเอาไปใช้ ใช้ worksheetchange มันแปลกๆอยู่ครับ
ยังไงแล้วผมจะลองเปลี่ยนมาเป็นแบบ Function ก่อนตามอาจารย์เพื่อทำส่วนต่อไปดูครับ

ขอขอบคุณอาจารย์และทุกๆท่านอย่างสูง ที่ทำให้งาน VBA Excel ครั้งแรกของผมใกล้ความจริงแล้วครับ
ยังไงหากเสร็จแล้ว หรือติดส่วนต่อไปจะกลับมาโพสต์ต่อ หรือแจ้งจบงานครับ
ขอบคุณครับ

[eyepop99]

จากตัว VBA ที่เขียนขึ้น
ถ้าใช้ worksheet change ทุกๆ ครั้งที่ range เปลี่ยน จะเกิดการคำนวนและการส่งค่า
ใส่ 10 เท่ากับรัน โปรแกรม 10 ครั้งซึ่งอาจจะทำให้เกิดความล้าช้า ได้ครับ
เหตุผลว่าทำไมถึงมีการ ใช้ Function แทน

[arampong]

จบงานแล้วครับ
ขอบคุณอาจารย์ eyepop99 และท่านอื่นๆด้วยครับ

ได้ลองเขียน worksheet change มีผลจริงๆเมื่อข้อมูลในการประมวลผลเยอะขึ้นครับ
จึงเปลี่ยนมาทำตามอาจารย์ eyepop99 ครับ

ผมไม่โพสต์ ตัวที่เลร็จแล้วน่ะครับ เพราะได้ทำตามอาจารย์ eyepop99 ทุกอย่างเลย
แค่เพื่มในส่วนของตารางมาหลายๆ ตารางเท่านั้นครับ แล้วค่อยสั่ง Run Macro ทีเดียวพร้อมกัน

ขอบคุณมากครับ

[arampong]

เรียนอาจารย์ ติดครับเรื่องตัวเลขตอนโยนค่าครับ
พอผมเปลี่ยนเป็นเลข 4 ทั้งระบบแล้วให้มันโยนค่าข้ามมาได้ 4,4,4 ทั้งๆที่บอกค่าห้ามเกิน 10 ครับ
ผมจะทำดัก Code ยังไงครับ และอีกอย่างถ้าจะให้มันเอามาแค่ 2 หรือไปหาช่องอื่นก่อนว่ามีค่าไหนที่มาบวกแล้วเท่ากับ 10 อยู่่ให้เอามารวมก่อน
ผมจะทำได้อย่างไรครับ

มาตายตอนจบ ฮ่าๆๆ ขอบคุณอีกครังครับ

[eyepop99]

เรียนอาจารย์ ติดครับเรื่องตัวเลขตอนโยนค่าครับ
พอผมเปลี่ยนเป็นเลข 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