Page 1 of 1

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

Posted: Wed Aug 21, 2024 9:39 pm
by 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


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

Posted: Wed Aug 21, 2024 11:08 pm
by 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

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

Posted: Wed Aug 21, 2024 11:51 pm
by 9KiTTi
puriwutpokin wrote: Wed Aug 21, 2024 11:08 pm ปรับตามนี้ครับ

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
ขอบพระคุณมากครับ ใช้งานได้อย่างที่ต้องการครับ