ขออนุญาตสอบถามกรณีเขียนVBAผสานคอลัมน์ได้ไม่ครบจำนวน

[9KiTTi]

ขออนุญาตสอบถามเขียนVBA เพื่อผสานคอลัมน์ทุกๆ4คอลัมน์ เริ่มผสานคอลัมน์B2ถึงE2ในชีทAB โดยมีเงื่อนไขว่าจำนวนคอลัมน์ที่ผสานจะต้องเท่าจำนวนคอลัมน์ที่มีข้อมูลในชีท AA ตั้งแต่แถวที่ B1 จนถึงคอลัมน์สุดท้ายที่มีข้อมูล ตามตัวอย่างที่แนบมาจะต้องผสานคอลัมน์ทุกๆ4คอลัมน์ จำนวน 18 คอลัมน์ แต่ผมลองเขียนแล้วผสานได้แค่ 5 คอลัมน์ ขอคำแนะนำด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub MergeColumnsInAB()
    Dim wsAB As Worksheet
    Dim wsAA As Worksheet
    Dim lastColumnAA As Long
    Dim colStart As Long
    Dim colEnd As Long
    Dim i As Long
    
    Set wsAB = ThisWorkbook.Sheets("AB")
    Set wsAA = ThisWorkbook.Sheets("AA")

    lastColumnAA = wsAA.Cells(1, wsAA.Columns.Count).End(xlToLeft).Column

    colStart = 2
    colEnd = 5
    
    For i = colStart To lastColumnAA Step 4
    
        If colEnd > wsAB.Columns.Count Then colEnd = wsAB.Columns.Count
 
        With wsAB.Range(wsAB.Cells(2, colStart), wsAB.Cells(2, colEnd))
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With

        colStart = colStart + 4
        colEnd = colEnd + 4
    Next i
    
End Sub

[puriwutpokin]

ปรับตามนี้ครับ

Code: Select all

Sub MergeColumnsInAB()
    Dim wsAB As Worksheet
    Dim wsAA As Worksheet
    Dim lastColumnAA As Long
    Dim colStart As Long
    Dim colEnd As Long
    Dim i As Long
    
    Set wsAB = ThisWorkbook.Sheets("AB")
    Set wsAA = ThisWorkbook.Sheets("AA")

    lastColumnAA = wsAA.Cells(1, wsAA.Columns.Count).End(xlToLeft).Column - 1

    colStart = 2
    colEnd = 5
    
    For i = colStart To lastColumnAA * 4 Step 4
    
        If colEnd > wsAB.Columns.Count Then colEnd = wsAB.Columns.Count
 
        With wsAB.Range(wsAB.Cells(2, colStart), wsAB.Cells(2, colEnd))
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With

        colStart = colStart + 4
        colEnd = colEnd + 4
    Next i
    
End Sub

[9KiTTi]

ปรับตามนี้ครับ

Code: Select all

Sub MergeColumnsInAB()
    Dim wsAB As Worksheet
    Dim wsAA As Worksheet
    Dim lastColumnAA As Long
    Dim colStart As Long
    Dim colEnd As Long
    Dim i As Long
    
    Set wsAB = ThisWorkbook.Sheets("AB")
    Set wsAA = ThisWorkbook.Sheets("AA")

    lastColumnAA = wsAA.Cells(1, wsAA.Columns.Count).End(xlToLeft).Column - 1

    colStart = 2
    colEnd = 5
    
    For i = colStart To lastColumnAA * 4 Step 4
    
        If colEnd > wsAB.Columns.Count Then colEnd = wsAB.Columns.Count
 
        With wsAB.Range(wsAB.Cells(2, colStart), wsAB.Cells(2, colEnd))
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With

        colStart = colStart + 4
        colEnd = colEnd + 4
    Next i
    
End Sub

ขอบพระคุณมากครับ ใช้งานได้อย่างที่ต้องการครับ