多行内容合并到同一个单元格

<ExcelVBA>多行内容合并到同一个单元格_第1张图片

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


你可能感兴趣的:(ExcelVBA,Yogurt_cry,合并单元格,ExcelVBA练习)