选中列后批量合并后并填充原值

yewei113

见附件   谢谢大佬
说明：选中a列后，执行vba代码后，原位置变成f到h列的效果。因为数据列很多，只对选中的列进行取消合并后并填充其他列不变。不要固定处理a列，是选中哪列处理哪列，谢谢大佬。

爱疯

Sub test()
    Dim A, x, i, j, k

    Application.ScreenUpdating = False
    Sheets(1).Select
    x = InputBox("输入列号:", , "A")
    x = Cells(1, x).Column
    i = Cells(Rows.Count, 2).End(xlUp).Row
    A = Range(Cells(1, x), Cells(i, x))

    For i = 3 To UBound(A)
        If Cells(i, x).MergeArea.Count > 1 Then
            If A(i, 1) <> "" Then
                k = i + Cells(i, x).MergeArea.Count - 1
                For j = i + 1 To k
                    A(j, 1) = A(i, 1)
                Next
                i = k
            End If
        End If
    Next

    Columns(x).UnMerge
    Cells(1, x).Resize(i - 1) = A
End Sub


选中列后批量合并后并填充原值2.rar (15.8 KB, 下载次数: 2)

2020-12-16 11:01 上传

点击文件名下载附件

yewei113

谢谢，高手