单元格内容按指定分隔符拆分为单独一行

hnjz6700

本人小白，请高人用AVB帮忙解决。

感谢feilanga与liulang0808版主用VBA写的代码，
追加一步请高手再次帮忙。

feilanga

。。。。。。。。。。。。。。。。。。。。。。。。。

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    arr = Sheets("检测台帐").UsedRange
    brr = Sheets("检测台帐").[a1].Resize(Rows.Count, UBound(arr, 2))
    r = 1
    For j = 2 To UBound(arr)
        If Len(arr(j, 9)) > 0 Then
            crr = Split("；" & arr(j, 9), "；")
            drr = Split("；" & arr(j, 10), "；")
            wrr = Split("；" & arr(j, 11), "；")
            For i = 1 To UBound(crr)
                r = r + 1
                For w = 1 To UBound(arr, 2)
                    brr(r, w) = arr(j, w)
                Next w
                brr(r, 9) = crr(i)
                brr(r, 10) = drr(i)
                brr(r, 11) = wrr(i)
            Next i
        End If
    Next j
    Sheets("拆分要求").[a1].Resize(r, UBound(brr, 2)) = brr
    Application.ScreenUpdating = True
End Sub

liulang0808

附件内容供参考。。。。。

ggmmlol

不需要用VBA，用基础方法即可。
步骤：
1、选中I、J、K三列，把分号替换为 换行符。（“换行符”，用Ctrl+J输入）
2、用WORD打开一个空白文档，把页面纸张大小设置为A3,方向设置为横向
3、把EXCEL工作表全部内容选中，复制，粘贴到WORD空白文档中
4、把WORD文档中的全部内容选中，复制，粘贴回EXCEL的新增的空白工作表中。（效果见附件）
5、把合并单元格取消合并，并通过定位空白单元格的方法进行批量填充的方法把A-H列的空白部分补充完整。（此步骤，请自行完成）
单元格拆分.rar (115.03 KB, 下载次数: 6)

2022-11-16 23:11 上传

点击文件名下载附件

hnjz6700

liulang0808 发表于 2022-11-16 22:58
附件内容供参考。。。。。

谢谢老师，谢谢老师，谢谢老师！

hnjz6700

feilanga 发表于 2022-11-16 22:53
。。。。。。。。。。。。。。。。。。。。。。。。。

谢谢老师，谢谢老师，谢谢老师！

wanao2008

适用于第二个压缩包，只能找到部分数据，代码如下：
Sub byWanao()
    Dim i&, j&, k&, arr
    arr = Sheets("设备与参数").UsedRange
    With Sheet1
        For i = 2 To UBound(arr)
            For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
                If arr(i, 2) = .Cells(j, "f") And arr(i, 3) = .Cells(j, "i") And arr(i, 5) = .Cells(j, "j") Then
                    For k = 1 To 3
                        .Cells(j, 14 + k) = arr(i, k + 5)
                    Next
                    Exit For
                End If
            Next
        Next
    End With
End Sub

hnjz6700

wanao2008 发表于 2022-11-21 17:46
适用于第二个压缩包，只能找到部分数据，代码如下：
Sub byWanao()
    Dim i&, j&, k&, arr

老师，重复出现的不能查出来，帮我再看看好吗，

wanao2008

hnjz6700 发表于 2022-11-29 19:38
老师，重复出现的不能查出来，帮我再看看好吗，

你再开新贴求助吧！