如何 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
