将x-n,y-m范围内的数据拆分成多行

Z平生

将零件位置列中有多个零件位置代码，格式如表一，拆分每个零件位置代码为一行，如表二。谢谢

沈默00

沈默00

没发现少了一行？

A1=LET(a,表2!$A$2:$B$85,b,CHOOSEROWS(UNIQUE(a),ROW(A1)),IFERROR(HSTACK(b,TEXTJOIN(",",,FILTER(表2!$C$2:$C$85,表2!$A$2:$A$85=TAKE(b,,1)))),""))   下拉

沈默00

lz还要组合呀？
有点难整，，我也期待下

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, cr, i&, j&, k&, r&, m&, n&, strTemp$
   
    Application.ScreenUpdating = False

    ar = Intersect([A1].CurrentRegion, Columns("B:E")).Value
    ReDim br(10 ^ 3, 1 To 3)
    br(0, 1) = "物料编号": br(0, 2) = "物料名称": br(0, 3) = "零件位置"
   
    With CreateObject("VBScript.RegExp")
        .Pattern = "([A-Z]+)(\d+)\-([A-Z]+)(\d+)"
        For i = 2 To UBound(ar)
            ar(i, 4) = Replace(ar(i, 4), Chr(10), "")
            cr = Split(ar(i, 4), ",")
            For j = 0 To UBound(cr)
                If .TEST(cr(j)) Then
                    strTemp = .Execute(cr(j))(0).submatches(0)
                    m = .Execute(cr(j))(0).submatches(1)
                    n = .Execute(cr(j))(0).submatches(3)
                    For k = m To n
                        r = r + 1
                        br(r, 1) = ar(i, 1): br(r, 2) = ar(i, 2): br(r, 3) = strTemp & m
                    Next k
                Else
                    r = r + 1
                    br(r, 1) = ar(i, 1): br(r, 2) = ar(i, 2): br(r, 3) = cr(j)
                End If
            Next j
        Next i
    End With
   
    With Worksheets(2)
        .Cells.Clear
        .[A1].Resize(r + 1, 3) = br
        .Activate
    End With
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

/////////////

gwjkkkkk

.................

cnmlgb9998

公式就能解决的问题，要什么 VBA？

ww87725244

cnmlgb9998 发表于 2024-7-26 22:22
公式就能解决的问题，要什么 VBA？

不对，C6-C11还要拆分

沈默00

cnmlgb9998 发表于 2024-7-26 22:22
公式就能解决的问题，要什么 VBA？

VBA相对好处理些，，
公式对后面的合并，，，应该可以处理，不好整。。。