Snasui Excel Forum

Code: Select all

Sub FillData()
Dim rs As Range, rsAll As Range
Dim rt As Range, rt1 As Range, rt2 As Range
Dim a() As Variant, c As Integer
Dim i As Integer, lng As Long
lng = Rows.Count
With Worksheets("ใบสั่งซื้อ")
        .Range("A12:A31,B12:G31") = ""
        Set rt1 = .Range("B5")
        Set rt2 = .Range("D31")
End With
With Worksheets("ฐานข้อมูล")
        Set rsAll = .Range("D3", .Range("D" & lng).End(xlUp))
End With
For Each rs In rsAll
    If rs = rt1 Then
        ReDim Preserve a(3, c)
        a(0, c) = rs.Offset(, 1)
        a(1, c) = rs.Offset(, 2)
        a(2, c) = rs.Offset(, 3)
        a(3, c) = rs.Offset(, 4)
        c = c + 1
    End If
Next
Worksheets("ใบสั่งซื้อ").Range("B11") = "Running"
For i = 0 To UBound(a, 2)
        Set rt = Worksheets("ใบสั่งซื้อ").Range("B" & lng).End(xlUp).Offset(1, 0)
        rt = a(0, i): rt.Offset(0, 3) = a(1, i)
        rt.Offset(0, 4) = a(2, i): rt.Offset(0, 5) = a(3, i)
        rt.Offset(, -1) = i + 1
        Worksheets("ใบสั่งซื้อ").Range(rt, rt2).Justify
Next i
Worksheets("ใบสั่งซื้อ").Range("B11") = ""
MsgBox "Finish"
End Sub

Code: Select all

Sub FillData()
Dim rs As Range, rsAll As Range
Dim rt As Range, rt1 As Range, rt2 As Range
Dim a() As Variant, c As Integer
Dim i As Integer, lng As Long
lng = Rows.Count
With Worksheets("ใบสั่งซื้อ")
        .Range("B12:B31,A12:A31,G12:G31") = ""
        Set rt1 = .Range("B5")
        Set rt2 = .Range("D31")
End With
With Worksheets("ฐานข้อมูล")
        Set rsAll = .Range("D3", .Range("D" & lng).End(xlUp))
End With
For Each rs In rsAll
    If rs = rt1 Then
        ReDim Preserve a(1, c)
        a(0, c) = rs.Offset(, 1)
        a(1, c) = rs.Offset(, 4)
        c = c + 1
    End If
Next
Worksheets("ใบสั่งซื้อ").Range("B11") = "Running"
For i = 0 To UBound(a, 2)
        Set rt = Worksheets("ใบสั่งซื้อ").Range("B" & lng).End(xlUp).Offset(1, 0)
        rt = a(0, i): rt.Offset(0, 5) = a(1, i): rt.Offset(, -1) = i + 1
        Worksheets("ใบสั่งซื้อ").Range(rt, rt2).Justify
Next i
Worksheets("ใบสั่งซื้อ").Range("B11") = ""
MsgBox "Finish"
End Sub

Code: Select all

Sub JustifyRange()
With Worksheets("ใบสั่งซื้อ")
    .Range("B12").Formula = _
    "=IF(N($A12),LOOKUP(ROWS(B$12:B12),ฐานข้อมูล!$Q:$Q,ฐานข้อมูล!E:E),"""")"
    .Range("B12").Copy
    .Range("B12:B21").PasteSpecial xlPasteFormulas
    .Range("B12:D21").Copy
    .Range("B12").PasteSpecial xlPasteValues
    .Range("B12:D21").Justify
End With
End Sub