如何 Excel 垂直合併儲存格中的文字到第一個

應該經常遇到說上下文被儲存格分開了，需要合併又只能手動剪下文字，不然直接按合併第二格之後的文字會通通不見。

寫了個腳本來處理這件事件，腳本可以指定到快捷鍵加速操作，平常也不需要貼到目標 xlsx 檔案上只需要儲存在一個屬於自己的 xlsm 上面，當你需要這功能的時候打開這個檔案在背景就可以了。

快捷鍵可能每次都要在目標 xlsx 上重設，不過這幾乎不成問題就是了。

腳本

Sub CombineTextInColumns()
    Dim rng As Range
    Dim cell As Range
    Dim startCell As Range
    Dim combinedText As String
    Dim col As Long
    Dim shouldMerge As Boolean

    ' 控制是否合併儲存格的變數
    shouldMerge = False  ' 如果設為 False 則不合併儲存格，如果設為 True 則合併儲存格

    ' 確認用戶已選擇儲存格
    If Not TypeName(Selection) = "Range" Then
        MsgBox "請選擇儲存格"
        Exit Sub
    End If

    Set rng = Selection
    ' 按列處理選定範圍
    For col = 1 To rng.Columns.Count
        Set startCell = rng.Cells(1, col)
        combinedText = startCell.Value
        ' 合併每一列中的文字到第一個儲存格
        For Each cell In rng.Columns(col).Cells
            If cell.Address <> startCell.Address Then
                If combinedText <> "" And cell.Value <> "" Then
                    combinedText = combinedText & Chr(10) & cell.Value
                ElseIf cell.Value <> "" Then
                    combinedText = cell.Value
                End If
            End If
        Next cell

        ' 更新第一個儲存格的內容
        startCell.Value = combinedText
        startCell.WrapText = True

        ' 清除該列中第一個儲存格以外的其他儲存格內容
        For Each cell In rng.Columns(col).Cells
            If cell.Address <> startCell.Address Then
                cell.ClearContents
            End If
        Next cell

        ' 根據條件合併儲存格
        If shouldMerge Then
            rng.Columns(col).Merge
            rng.Columns(col).VerticalAlignment = xlTop
        End If
    Next col

    ' 自動調整所有選定範圍的行高
    rng.Rows.AutoFit
End Sub

補一個日文註解版本的

Sub CombineTextInColumns()
    Dim rng As Range
    Dim cell As Range
    Dim startCell As Range
    Dim combinedText As String
    Dim col As Long
    Dim shouldMerge As Boolean

    ' セルをマージするかどうかを制御する変数
    shouldMerge = False  ' False の場合はセルをマージしない、 True の場合はセルをマージ

    ' ユーザーがセルを選択していることを確認
    If Not TypeName(Selection) = "Range" Then
        MsgBox "セルを選択してください"
        Exit Sub
    End If

    Set rng = Selection
    ' 選択範囲の各列を処理
    For col = 1 To rng.Columns.Count
        Set startCell = rng.Cells(1, col)
        combinedText = startCell.Value
        ' 各列のセルのテキストを最初のセルに結合
        For Each cell In rng.Columns(col).Cells
            If cell.Address <> startCell.Address Then
                If combinedText <> "" And cell.Value <> "" Then
                    combinedText = combinedText & Chr(10) & cell.Value
                ElseIf cell.Value <> "" Then
                    combinedText = cell.Value
                End If
            End If
        Next cell

        ' 最初のセルの内容を更新
        startCell.Value = combinedText
        startCell.WrapText = True

        ' 最初のセル以外のセルの内容をクリア
        For Each cell In rng.Columns(col).Cells
            If cell.Address <> startCell.Address Then
                cell.ClearContents
            End If
        Next cell

        ' 条件に基づいてセルをマージ
        If shouldMerge Then
            rng.Columns(col).Merge
            rng.Columns(col).VerticalAlignment = xlTop
        End If
    Next col

    ' 選択範囲のすべての行の高さを自動調整
    rng.Rows.AutoFit
End Sub