รบกวนขอคำปรึกษาในการเขียน Code vba

[sompong999]

รบกวนขอคำปรึกษาในการเขียน Code vba เนื่องจากได้ลองเขียน vba ใน excel แล้วรู้สึกว่ามันยาวมากการเขียน
โจทย์ที่ต้องการคือจะมีข้อมูลอยู่ 3 sheet
Sheet 1 คือ ID STORE ในตัวอย่างมีจำนวน 50 ID อาจเพื่มหรือลดลงได้ เช่น 30,40,60 ID
Sheet 2 คือ Barcode ในตัวอย่างมีจำนวน 50 Barcode อาจเพื่มหรือลดลงได้เช่น 30,40,100 รายการ
Sheet 3 คือ ผลลัพท์ที่ออกมาในคอลัมน์ A และ B เงื่อนไขที่เขียนคือ Copy เลขที่ ID บรรทัดแรกไปสร้าง 50 บรรทัด ใน Sheet Compare คอลัมน์ A บรรทัดที่ 2 และต่อมา Copy ข้อมูลใน Sheet Barcode ทีมีอยู่ คอลัมน์ A บรรทัดที่ 2 ไปวาง Sheet Compare คอลัมน์ B 50 บรรทัด แล้วต่อมาก็ให้ทำในเลข ID STORE บรรทัดต่อไป วนไปจนครบเลขที่ ID
รบกวนปรึกษาว่าสามารถเขียน Code ให้สั้นลงกว่าที่เขียนได้ไหมครับ ผมแนบตัวอย่างให้แล้วครับ รบกวนอาจารย์ให้คำแนะนำด้วยครับ ขอบพระคุณมากครับ

[snasui]

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

Code: Select all

Sub Test0()
    Dim arrStore As Variant, arrBarcode As Variant, arrStB As Variant
    Dim m As Long, n As Long, l As Long
    With Worksheets("ID STORE")
        arrStore = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    With Worksheets("Barcode")
        arrBarcode = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    ReDim arrStB(1 To UBound(arrStore) * UBound(arrBarcode), 1 To 2)
    l = 1
    For m = 1 To UBound(arrStore)
        For n = 1 To UBound(arrBarcode)
            arrStB(l, 1) = arrStore(m, 1)
            arrStB(l, 2) = arrBarcode(n, 1)
            l = l + 1
        Next n
    Next m
    With Worksheets("Compare")
        .Range("a2").CurrentRegion.Offset(1, 0).ClearContents
        .Range("a2").Resize(l - 1, 2).Value = arrStB
    End With
    MsgBox "Finished.", vbInformation
End Sub

[sompong999]

ขอบพระคุณมากครับ อาจารย์ ลองแกะ Code ของอาจารย์แล้วง่ายและกระซับมาก
ได้ความรู้เพื่มขึ้น สำหรับ Link ที่อาจารย์แนบมาจะเข้าไปศึกษาและกดติดตามให้ครับเป็นคลังแสงความรู้ดีมากครับ
ขอบพระคุณอีกครั้งครับ

[Bo_ry]

Code: Select all

Sub Test()
Dim Id&, Bc&, n&, I, B
    Id = Sheets("ID STORE").Cells(Rows.Count, 1).End(xlUp).Row - 1
    Bc = Sheets("Barcode").Cells(Rows.Count, 1).End(xlUp).Row - 1
    n = Id * Bc
    I = Application.Index(Sheets("ID STORE").Columns(1), Evaluate("(row(1:" & n & ")-1)/" & Bc & "+2"))
    B = Application.Index(Sheets("Barcode").Columns(1), Evaluate("MOD(ROW(1:" & n & ")-1," & Bc & ")+2"))
    Sheets("Compare").[a2].CurrentRegion.Offset(1).ClearContents
    Sheets("Compare").[a2].Resize(n, 2) = Application.Choose(Array(1, 2), I, B)
End Sub