每月都要执行固定操作

yongyuan61

我每个月都要执行表上传中的固定操作，将基础表中的数据，转化为表二格式。各位大神有什么好的办法，请各位大神帮助。其中最末级数据为分级里的最末级，有的处于第一层，有的处于第二层；每月列不固定。

loirol

复制，选择性黏贴，转置

lu553178681

B2=

1. =+TRANSPOSE(FILTER(基础!$C$5:$AD$19,ISNUMBER(FIND("末级",基础!$B$5:$B$19))))

复制代码

3190496160

Sub 统计()
Dim ar As Variant
Dim br()
Dim i As Long, r As Long
With Sheets("基础")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(4, Columns.Count).End(xlToLeft).Column
    If r < 5 Or y < 4 Then MsgBox "基础数据工作表为空，请先导入数据！": End
   ar = .Range(.Cells(4, 1), .Cells(r, y))
End With
ReDim br(1 To UBound(ar, 2), 1 To UBound(ar))
For j = 4 To UBound(ar, 2)
    y = 1
    If ar(1, j) <> "" Then
        n = n + 1
        br(n, 1) = Split(ar(1, j), Chr(10))(1)
        For i = 2 To UBound(ar)
            If InStr(ar(i, 2), "末级") > 0 Then
                y = y + 1
                br(n, y) = ar(i, j)
            End If
        Next i
    End If
Next j
With Sheets("达到效果")
    .[a1].CurrentRegion.Offset(1).Borders.LineStyle = 0
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(n, y) = br
    .[a2].Resize(n, y).Borders.LineStyle = 1
End With
MsgBox "ok!"
End Sub

3190496160

费用.rar (17.08 KB, 下载次数: 8)

2024-12-20 14:41 上传

点击文件名下载附件

sobili

用PQ做了个附件。希望对楼主有帮助。 费用.rar (22.79 KB, 下载次数: 3)

2024-12-21 23:48 上传

点击文件名下载附件

yongyuan61

3190496160 发表于 2024-12-20 14:41

您好：
成本名称，有的结构叫末级，有结构叫办公室，费用名称，每个月都变，能帮助想办法处理一下吗？。

3190496160

yongyuan61 发表于 2024-12-24 11:56
您好：
成本名称，有的结构叫末级，有结构叫办公室，费用名称，每个月都变，能帮助想办法处理一下吗？。

论坛是做义务的，大家都有自己的工作要做，代码只是业余爱好而已，所以，在论坛写代码，只能是针对你上传的附件和需求描述来写代码，你目前上传的附件，显然是在误导帮你的人，你事先也没有具体描述清楚
具体如何才能判断出来是末级，你要有具体的说明，毕竟，别人不是做你的工作的，别指望你不说，别人也能知道你的工作详情，