多sheet合并问题

掌中烛火

有A,B,C,D 4个sheet,需要合并为下列格式，有没有什么简单的办法。

dambcer

PQ。。。。。。。。。。。。。。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar(), br, i&, j&, k&, n&, r&, c&, wks As Worksheet
   
    Application.ScreenUpdating = False
   
    For Each wks In Worksheets
        If wks.Name <> "Sheet1" Then
            n = n + 1
            ReDim Preserve ar(1 To n)
            ar(n) = wks.[A1].CurrentRegion.Value
            If UBound(ar(n)) > r Then r = UBound(ar(n))
            If UBound(ar(n), 2) > c Then c = UBound(ar(n), 2)
        End If
    Next
   
    ReDim br(1 To r, 1 To c)
    For i = 1 To UBound(ar)
        For k = 1 To UBound(ar(i))
            br(k, 1) = ar(i)(k, 1)
        Next k
        For j = 2 To UBound(ar(i), 2)
            For k = 1 To UBound(ar(i))
                If Len(ar(i)(k, j)) Then br(k, j) = ar(i)(k, j)
            Next k
        Next j
    Next i
   
    With Worksheets("Sheet1")
        .Cells.Clear
        With .[A1].Resize(r, c)
            .Value = br
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .EntireColumn.AutoFit
            .Rows(1).Interior.Color = vbYellow
        End With
        .Activate
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

掌中烛火

gwjkkkkk 发表于 2024-6-17 19:56
参与一下。。。

一个场景如果参差不齐就会错行。

掌中烛火

dambcer 发表于 2024-6-17 19:16
PQ。。。。。。。。。。。。。。

提示版本不一样，用不了，不了解M函数，只会用上面自带的一些功能

gwjkkkkk

掌中烛火 发表于 2024-6-18 09:03
一个场景如果参差不齐就会错行。

可以用字典定位一下。

zpy2

//select * from consolidateSheet limit 5;
cli_one_dim_c~consolidateSheet~3;
create temp table aa as
select row_number() over (partition by 属性) grp,colIndex[2:] from consolidateSheetUnion where 数量 <>"-";
//select * from aa limit 300;
cli_create_two_dim~aa~属性~数量;
select * from aa_two_dim;