在Excel中合并单元格而不丢失数据

首先对此做了一个新的线程抱歉，但我不能在现有的线程中发表评论。

我试图合并很多像这个线程一样的单元格，但是我对编码有一些新的东西，特别是excel / VBA，所以我没有得到它的工作。 我有相同的情况（除了我没有任何空的行），所以我只是试图使用现有线程中的代码不真正理解语法：

Sub mergecolumn() Dim cnt As Integer Dim rng As Range Dim str As String For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 cnt = Cells(i, 1).MergeArea.Count Set rng = Range(Cells(i, 2), Cells(i - cnt + 1, 2)) For Each cl In rng If Not IsEmpty(cl) Then str = str + vbNewLine + cl Next If str <> "" Then str = Right(str, Len(str) - 2) Application.DisplayAlerts = False rng.Merge rng = str Application.DisplayAlerts = True str = "" i = i - cnt + 1 Next i End Sub 

我试图以不同的方式运行macros，标记多个列，标记多行并标记一些区域，但我总是得到：

运行时错误“13”：
types不匹配

当我去debugging屏幕这标记：

 str = str + vbNewLine + cl 

我通过开发人员 – function区 – > Visual Basic – >插入 – >模块添加了macros，并将代码粘贴到那里并保存。

在此先感谢您的帮助
//乔金 –

Answer 1

这里有两个版本的代码。

VER 1 （不忽略空白单元格）

 '~~> For Group MERGING (Merge Cells and Keep All text) Public Sub Sample() On Error GoTo ErrMergeAll Application.DisplayAlerts = False Dim Cl As Range Dim strTemp As String '~~> Collect values from all the cells and separate them with spaces For Each Cl In Selection If Len(Trim(strTemp)) = 0 Then strTemp = strTemp & Cl.Value Else strTemp = strTemp & vbNewLine & Cl.Value End If Next strTemp = Trim(strTemp) '~~> Merging of cells With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .MergeCells = False End With Selection.Merge '~~> Set new value of the range Selection.Value = strTemp Application.DisplayAlerts = True Exit Sub ErrMergeAll: MsgBox Err.Description, vbInformation Application.DisplayAlerts = True End Sub 

VER 2 （忽略空白单元格）

 '~~> For Group MERGING (Merge Cells and Keep All text) Public Sub Sample() On Error GoTo ErrMergeAll Application.DisplayAlerts = False Dim Cl As Range Dim strTemp As String '~~> Collect values from all the cells and separate them with spaces For Each Cl In Selection If Len(Trim(Cl.Value)) <> 0 Then If Len(Trim(strTemp)) = 0 Then strTemp = strTemp & Cl.Value Else strTemp = strTemp & vbNewLine & Cl.Value End If End If Next strTemp = Trim(strTemp) '~~> Merging of cells With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .MergeCells = False End With Selection.Merge '~~> Set new value of the range Selection.Value = strTemp Application.DisplayAlerts = True Exit Sub ErrMergeAll: MsgBox Err.Description, vbInformation Application.DisplayAlerts = True End Sub 

屏幕截图