VBA Merge เซลล์อัตโนมัติหลังจากกรอกข้อมูล

[Botman03]

มีไฟล์การรับสินค้าเข้าครับ ผมได้สร้างUserformไว้เพื่อกรอกค่าลงในแต่ละเซลดังรูปที่1 ผมต้องการให้
- เมื่อกรอกข้อมูลสินค้าลงไปแล้ว ต้องการให้คอลัมท์ No,Date,TransportCompany,Truck, Merge เซลให้เท่ากับจำนวน Material (หรือ Merge เซล ลงข้างล่าง3เซล)

- ต้องการคุม range ในการรันสูตรแค่ เซล (A:G)
รบกวนทุกท่านด้วยนะครับ เพิ่งเริ่มศึกษาครับ พยายามเอา Code นี้มาปรับใช้ของตัวเองแล้ว ปรากฎว่าแถวสุดท้ายจะ Mergeข้อมูลยาวลงไปกว่าที่ต้องการมาก , และ หัวข้อ Remark ถ้าไม่ได้ใส่ค่า จะmerge ทั้งหมดเลยครับ
ขออภัยที่ไม่ได้แนบไฟล์เนื่องจากเป็นนโยบายเผยแพร่เอกสารของบริษัทครับ


Sub x()
Dim Wks As Worksheet, Col As Range, Ar As Range
On Error Resume Next
Application.DisplayAlerts = False
For Each Col In ActiveSheet.UsedRange.Columns
For Each Ar In Col.SpecialCells(xlCellTypeBlanks).Areas
Ar.Offset(-1).Resize(Ar.Rows.Count + 1).Merge
Next
Next
Columns.VerticalAlignment = xlVAlignCenter
Application.DisplayAlerts = True
End Sub

[DhitiBank]

ควรแนบไฟล์ตัวอย่างมาด้วยครับ เพื่อนๆ จะได้เอาไปช่วยทดสอบได้สะดวกครับ และสำหรับการโพสต์โค้ดก็เช่นกัน ตามกฎบอร์ดข้อ 4, 5 ด้านบนครับ

[Botman03]

ควรแนบไฟล์ตัวอย่างมาด้วยครับ เพื่อนๆ จะได้เอาไปช่วยทดสอบได้สะดวกครับ และสำหรับการโพสต์โค้ดก็เช่นกัน ตามกฎบอร์ดข้อ 4, 5 ด้านบนครับ

ขอบคุณมากครับ พอดีเรื่องไฟล์แนบทางบริษัทล็อคไฟล์ไว้ไม่ให้ส่งออกไปภายนอกครับ เลยส่งให้ไม่ได้จริงๆ

Code: Select all

Sub x()
Dim Wks As Worksheet, Col As Range, Ar As Range
On Error Resume Next
Application.DisplayAlerts = False
For Each Col In ActiveSheet.UsedRange.Columns
For Each Ar In Col.SpecialCells(xlCellTypeBlanks).Areas
Ar.Offset(-1).Resize(Ar.Rows.Count + 1).Merge
Next
Next
Columns.VerticalAlignment = xlVAlignCenter
Application.DisplayAlerts = True
End Sub

[snasui]

ให้ทำมาเป็นตัวอย่างเลียนแบบไฟล์จริง ไม่ใช่นำไฟล์จริงมาเป็นตัวอย่างครับ