能用宏达成右边的效果

阿煮

左边是原始数据，右边是想要的效果。我平时用POWERQUERY实现；才开始学宏。想请教如何用宏实现呢。求指点~

3190496160

Sub 拆分()
Dim ar As Variant
Dim br()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:b" & r)
    ReDim br(1 To 50000, 1 To UBound(ar, 2))
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            If InStr(ar(i, 1), Chr(10)) = 0 Then
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    br(n, j) = ar(i, j)
                Next j
            Else
                rr = Split(ar(i, 1), Chr(10))
                For s = 0 To UBound(rr)
                    If Trim(rr(s)) <> "" Then
                        n = n + 1
                        br(n, 1) = rr(s)
                        For j = 2 To UBound(ar, 2)
                            br(n, j) = ar(i, j)
                        Next j
                    End If
                Next s
            End If
        End If
    Next i
    rs = .Cells(Rows.Count, 4).End(xlUp).Row
    .Range("d1:e" & rs) = Empty
    .[d1].Resize(n, UBound(br, 2)) = br
End With
MsgBox "ok!"
End Sub

3190496160

3190496160

拆分.rar (13.98 KB, 下载次数: 16)

2023-4-6 17:08 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, cr, i&, j&, r&
   
    ar = [A2].CurrentRegion
    ReDim br(1 To UBound(ar) * 10, 1 To 2)
    For i = 1 To UBound(ar)
         cr = Split(ar(i, 1), vbLf)
         For j = 0 To UBound(cr)
             r = r + 1
             br(r, 1) = cr(j)
             br(r, 2) = ar(i, 2)
         Next j
    Next i
   
    Columns("H:I").Clear
    [H2].Resize(r, 2) = br
End Sub