Sub Test()
With Sheet1
'准备阶段
.Range("C:C").Clear '清除C列中数据即格式
'定义数据类型
Dim k() As Integer '定义一个整型数组k()，用于存放获取到的数据
Dim ks As Integer '定义一个整型ks，作为整型数组k()的序列号
Dim UseCount As Integer '定义一个整型UseCount，用于记录统计【合并单元格】的总数量
Dim EndRow As Integer '定义一个整型EndRow，用于记录需要进行合并的数据的最后一行的行数，同时也是总行数
UseCount = Application.WorksheetFunction.CountA(Range("A1:A1000")) '调用Excel函数CountA获取【合并单元格】的数量，并赋值给UseCount
EndRow = .Range("D1000").End(xlUp).Row '使用End()方法获取需要合并的数据的最后一行的函数，并赋值给EndRow
'获取对应单元格的单元格地址
ks = 0 '使ks为零
ReDim k(UseCount) '重新定义数组k()的数组元素的数量
For i = 1 To EndRow '设置循环判断，从第一行到需要合并的数据的最后一行
If .Range("B" & i) <> "" Then '通过If...Then方法来获取当合并单元格的值不为空时
k(ks) = i '数组k(ks)的值为i，i为行数
ks = ks + 1 '此时ks+1，然后进入下一个循环，如不能理解，详细解释请见公众号
End If
Next
k(UseCount) = EndRow '设置数组k()的最后一位为需要合并的数据的最后一行的行数
'执行输出
ks = 0 '重置ks为0
For i = 1 To EndRow '设置循环判断，从第一行到需要合并的数据的最后一行
If .Range("B" & i) <> "" Then '通过If...Then方法来获取当合并单元格的值不为空时
For j = k(ks) To k(ks + 1) '即进入从数组k()相邻的两个元素之间的循环值，如不能理解，详细解释请见公众号
.Range("C" & i) = .Range("C" & i) & vbCrLf & .Range("D" & j) '输出值到相对应合并单元格中的C列所对应的行中
Next
.Range("C" & k(ks)) = Replace(.Range("C" & k(ks)), vbCrLf, "", , 1) '将多余的回车符删除，保留最终结果
If ks < UseCount - 1 Then '判断序列号ks是否小于数组k()的总数-1，实际上是用于判断是否处理到了最后一个合并单元格，因为最后一个单元格出现了特殊情况
.Range("C" & k(ks) & ":C" & k(ks + 1) - 1).Merge '如是，则需要少合并一个单元格
Else
.Range("C" & k(ks) & ":C" & k(ks + 1)).Merge '如不是，则直接合并单元格
End If
ks = ks + 1 '然后ks+1，进入下一个循环
End If
Next
Cells.EntireRow.AutoFit '执行单元格行高的自动调整
.Range("C:C").ColumnWidth = 100 '执行单元格列宽的调整
.Range("C:C").EntireColumn.AutoFit '执行单元格列宽的自动调整
End With
End Sub