การจัดข้อความที่ลิงค์มาให้พอดีกับช่วงเซลล์

[joo]

ขอคำแนะนำหน่อยครับ... ที่ซีทใบสั่งซื้อในช่องรายการมีวิธีทำให้ข้อความที่ลิงค์มาให้แสดงพอดีกับช่วงเซลล์ที่กำหนดไว้ไหมครับ แบบว่าถ้าข้อความเกินบรรทัดที่
คอลัมภ์ D ก็ให้มาต่อที่บรรทัดลงด้านล่างไปเรื่อยๆ ในแต่ละรายการตามลำดับครับ

[snasui]

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

[joo]

ผมลองปรับการจัดเก็บข้อมูลที่ซีทฐานข้อมูลใหม่แล้วลองทำการลิงค์ข้อมูลมาที่ซีท "ใบสั่งซื้อ " แต่รูปแบบที่ได้ก็ไม่ตรงกับที่ต้องการ
-ลองทำการลิงค์ข้อมูลมาที่ซีท "Order " แต่รูปแบบที่ได้ก็ไม่ตรงกับที่ต้องการ
พอจะมีแนวทางทำได้ไหมครับ

[snasui]

การจะให้ข้อมูลล้นไปยังเซลล์ด้านขวาได้นั้นให้ยกเลิกการ Merge Cells ก่อนครับ นอกจากนี้เซลล์ด้านขวาจะต้องเป็นเซลล์ว่าง หากไม่เป็นเซลล์ว่างค่าในเซลล์ด้านซ้ายจะไม่ล้นมาได้ครับ

[snasui]

สำหรับฐานข้อมูลนั้นเก็บตามเติมเหมือนไฟล์แรกถูกต้องแล้วครับ

หากต้องการแยกบรรทัดเพื่อให้ดูสวยงามสามารถใช้ VBA เข้ามาจัดการ ผมทำตัวอย่างมาให้ดูตามด้านล่างโดยยึดไฟล์เดิมเป็นหลัก

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

[joo]

ขอบคุณครับที่แนะนำ...ได้ทดลองแล้วพบว่าข้อมูลที่แสดงตามเลขที่เอกสารจะไม่ตรงเป็นบางรายการ เช่น เอกสารเลขที่ 0004/2554,0005/2554,0008/2554 เป็นต้น และตรงซีทใบสั่งซื้อเวลาสั่งปริ้นท์จะเซทค่าไว้ที่ 100 เปอร์เซนต์ จึงต้องจัดให้ข้อความในช่องรายการแสดงให้ตรงกับลำดับและดูสวยงามมีวิธีปรับแก้ไหมครับ

[snasui]

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

เนื่องจากเห็นว่าค่อนข้างซับซ้อน ผมจึงปรับตัวอย่างมาให้ใหม่ตามด้านล่าง

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

ส่วนกรณีการพิมพ์แบบให้เต็มหน้า ลองบันทึก Macro การพิมพ์โดยปรับให้พอดีกับหนึ่งหน้า จากนั้นนำ Code Macro มาปรับด้วยตนเองก่อน ติดตรงไหนค่อยมาถามกันต่อครับ

[joo]

ทดลองโค๊ดที่แนะนำใหม่แล้วครับ...พบว่าส่วนอื่นแสดงผลได้ตามที่ต้องการ แต่ที่คอลัมภ์ Eแสดง "จำนวน" และคอลัมภ์ F แสดง "หน่วย" ค่าไม่ยอมแสดงตามรายการที่ลิงค์มาครับ
คิดว่าน่าจะเกี่ยวกับการเซทเรนจ์ลองปรับที่บรรทัดนี้ .Range("B12:B31,A12:A31,G12:G31,E12:E21") = "" ก็ไม่มีการเปลี่ยนแปลงครับ

[snasui]

ไม่ได้เกี่ยวกับ Range นั้นครับ ที่ค่าไม่มาเพราะไม่ได้เขียน Code ให้ดึงมาครับ

ผมปรับ Code มาให้ใหม่แล้วตามด้านล่าง ดูไฟล์แนบประกอบครับ

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

[joo]

ขอบคุณครับ...ทดลองแล้วใช้งานได้ตามที่ต้องการแล้วครับ