ขอคำแนะนำ การวนลูป หลายชั้น

[chatana_tiangam]

รบกวนขอคำแนะนำค่ะ

ทำการวนลูปโดยการดึงค่าจาก sheet3-cell ที่ b2 มาแสดงที่ sheet2-cell ที่ A2
แล้วทำการวนลูปหาค่าโดยดึงจาก sheet1 ข้อมูลแถบสีฟ้ามาแสดงที่ sheet2 แถบสีฟ้า
ไล่ไปเรื่อย ๆจนจบข้อมูลที่มีอยู่ไม่ว่ากี่บรรทัดก็ตาม แต่พอวนรอบสอง ต้องเป็นข้อมูล
ที่มาจาก sheet3-cell ที่ b3 ข้อมูลที่แสดงออกมาทีแต่มาแสดงที่ sheet2-cell ที่ A2 เท่านั้น
แต่ข้อมูลที่ดึงมาจาก sheet1ไม่มาด้วย จึงไม่แน่ใจว่าใส่ Loop หรือ ใช้ if ผิดจุดหรือเปล่า

ถ้าจะแก้ไขจะต้องปรับตรงไหนบ้างค่ะ
ขอบพระคุณค่ะ

Code: Select all

Sub search2()
    i = 2
    o = 2
    j = 2
    
 Do
    Sheets("Sheet2").Range("a2").Value = Sheets("Sheet3").Cells(o, 2)
    Do
        If Range("a2") = Sheets("Sheet1").Cells(i, 1) Then
            For x = 1 To 7
             Sheets("Sheet2").Cells(j, x + 1) = Sheets("Sheet1").Cells(i, x + 1)
            Next
            j = j + 1
        End If
            i = i + 1
    Loop Until Sheets("Sheet1").Cells(i, 1) = ""
    Sheets("Sheet2").Range("a2:o500").ClearContents
    o = o + 1
    Loop Until Sheets("Sheet3").Cells(o, 2) = ""
  
End Sub

[snasui]

จากตัวอย่างที่ให้มา ช่วยแสดงผลลัพธ์ที่ต้องการหากว่า Code ทำงานถูกต้องมาด้วย จะได้เข้าใจตรงกันครับ

[chatana_tiangam]

ทำการแนบไฟล์ที่จะให้แสดงผลให้แล้วค่ะ
ขอบพระคุณค่ะ

[DhitiBank]

สวัสดีครับ

ขอสอบถามเพิ่มเติมครับ ผมไม่แน่ใจว่าสิ่งที่ต้องการคืออะไรระหว่าง 2 อย่างต่อไปนี้ครับ:

1. เมื่อใส่ค่าเลขที่ใบสั่งซื้อใน Sheet2 เซลล์ A2 แล้วให้โค้ดเรียกรายการสินค้าของใบสั่งซื้อนั้นๆ ใน Sheet1 มาแสดงใน Sheet2 หรือว่า

2. ต้องการสั่งรันโค้ดแล้วให้ผลลัพธ์แสดงอย่างในรูปด้านล่างนี้ครับ

test.png

[DhitiBank]

หากต้องการให้แสดงอย่างในรูป ลองรันโค้ดนี้ครับ

Code: Select all

Public Sub Search_II()
    Dim r As Range, vPO As Variant _
            , l2 As Long, l3 As Long, i As Long _
            , m As Integer, n As Integer
            
    With Sheets("sheet2")
        .Range("a2:h" & .Rows.Count).Clear
    End With
    
    'Find total row of PO
    With Sheets("sheet3")
        l3 = .Range("b" & .Rows.Count).End(xlUp).Row
    End With
    
    'Loop...start
    For i = 2 To l3
        With Sheets("sheet2")
            vPO = Sheets("sheet3").Cells(i, 2).Value
            l2 = .Range("b" & .Rows.Count).End(xlUp).Row + 1
            .Cells(l2, 1).Value = vPO
            .Cells(l2, 1).Interior.Color = .Cells(1, 1).Interior.Color
        End With
        With Sheets("sheet1")
            Set r = .Range("a1")
            m = WorksheetFunction.CountIf(.Range("a:a"), vPO)
            n = 0
                Do While n < m
                    Set r = .Range("a:a").Find(What:=vPO, After:=r, LookIn:=xlValues _
                        , lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext _
                        , MatchCase:=False)
                    r.Offset(0, 1).Resize(1, 7).Copy
                    l2 = Sheets("sheet2").Range("b" & Sheets("sheet2").Rows.Count). _
                            End(xlUp).Row + 1
                    Sheets("sheet2").Cells(l2, 2).PasteSpecial xlPasteValues
                    Sheets("sheet2").Cells(l2, 2).PasteSpecial xlPasteFormats
                    n = n + 1
                Loop
        End With
    Next i
    Application.CutCopyMode = False
End Sub

ที่โค้ดยาวไปหน่อยเพราะเผื่อกรณีรายการสินค้าใน Sheet1 ของใบสั่งซื้อเดียวกันไม่ได้เรียงติดกันผมเลยใช้คำสั่ง Find ดักไว้ครับ และหากข้อมูลจริงมีเยอะมากก็อาจใส่คำสั่ง
Application.Calculation=xlCalculationManual ก่อนเริ่มลูป และ
Application.Calculation=xlCalculationAutomatic ตอนจบลูป
เข้าไปด้วยเพื่อให้โค้ดทำงานเร็วขึ้นครับ

[chatana_tiangam]

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

[snasui]

อีกตัวอย่าง Code ครับ

Code: Select all

Sub search2()
  Sheets("Sheet2").Range("a2:o500").ClearContents
    o = 2
    Do
       Sheets("Sheet2").Range("b" & Rows.Count).End(xlUp).Offset(1, -1) _
           .Value = Sheets("Sheet3").Cells(o, 2)
       i = 2
       j = Sheets("Sheet2").Range("b" & Rows.Count).End(xlUp).Offset(1, -1).Row
       Do
           If Sheets("Sheet2").Range("a" & Rows.Count).End(xlUp) = Sheets("Sheet1").Cells(i, 1) Then
               For x = 1 To 7
                    Sheets("Sheet2").Cells(j, x + 1) = Sheets("Sheet1").Cells(i, x + 1)
               Next
               j = j + 1
           End If
            i = i + 1
       Loop Until Sheets("Sheet1").Cells(i, 1) = ""
       o = o + 1
    Loop Until Sheets("Sheet3").Cells(o, 2) = ""
End Sub

[DhitiBank]

ขอบคุณอาจารย์มากครับ การสั่งให้คัดลอกค่าด้วย = เร็วกว่าการสั่งให้ copy-->paste มากจริงๆ

[chatana_tiangam]

ขอบคุณสำหรับทุกคำแนะนำค่ะ code ทั้งสองสามารถทำงานได้อย่างดีค่ะ แถมยังได้ความรู้จากการใช้โค้ดใหม่ๆ ด้วย
ขอบพระคุณค่ะ