一番上の入り口へ > excel > VBA コーディングライブラリ集 > 選択範囲でまとめて個別に縦にセル結合するマクロ

選択範囲でまとめて個別に縦にセル結合するマクロ

選択範囲の中で、縦方向に同じ値または空白である場合 セルを結合します。




Sub 選択範囲でまとめて個別にセルマージ()

 
    '準備-------------------------------------------------

    Dim row As Integer, column As Integer
    Dim height As Integer, width As Integer
    
    Dim startY As Integer, flag As Integer
    Dim beforeStr As String, i As Integer
    

    
    '各種メイン設定値
    row = Selection.row
    column = Selection.column
    
    height = Selection.Rows.Count
    width = Selection.Columns.Count
    
    
    For i = column To (column + width - 1)
        flag = 0
        startY = row
        beforeStr = Cells(row, i).Value
        
        For j = row + 1 To (row + height - 1)
            '同じセル
            If (Cells(j, i).Value = beforeStr) Then
                If flag = 2 Then
                    If j - 1 <> startY Then
                        Call MergeForce(startY, i, j - 1, i)
                        
                        '設定
                        flag = 0
                        startY = j
                        beforeStr = Cells(j, i).Value
                    Else
                        flag = 1
                    End If
                Else
                    flag = 1
                    If (j > startY) Then
                       Cells(j, i).Value = ""
                    End If
                 End If

            '空白セル
            ElseIf (IsNull(Cells(j, i)) Or Cells(j, i).Value = "") Then
                flag = 2
            Else
                If flag <> 0 Then
                    Call MergeForce(startY, i, j - 1, i)
                End If
                
                flag = 0
                startY = j
                beforeStr = Cells(j, i).Value
            End If
        Next j
        
        
        '最後の行まで完了
        If flag <> 0 Then
            Call MergeForce(startY, i, row + height - 1, i)
        End If
    Next i
 
End Sub


Function MergeForce(row1 As Integer, column1 As Integer, row2 As Integer, column2 As Integer)
    Range(Cells(row1, column1), Cells(row2, column2)).Select
    Selection.Merge
End Function

類似リンク

選択範囲シート名にハイパーリンクを追加するマクロ

選択範囲のハイパーリンクを一瞬で削除するVBA

VBA マクロライブラリ集