格式整理，救命啊，有点难度，请大神出手！！

070634206

shee1是收集上来的表格。是各个公司上报的各个部门各项费用预算，sheet2是需要整理成的格式，方便筛选。但有100家左右公司。复制粘贴太浪费时间了。烦请大神出手！！！救救我！！

高个子

这个正常情况应该是多簿吧？

shiruiqiang

还是比较规律的数据。不包售后，附件传不上

shiruiqiang

Sub test()
Dim arr, brr(1 To 1000000, 1 To 4)
Dim rng As Range
arr = Sheets(1).UsedRange
For y = 3 To UBound(arr, 2)
For x = 1 To UBound(arr) - 20
If InStr(arr(x, y), "公司") Then
For i = x + 3 To x + 19
k = k + 1
brr(k, 1) = arr(x, y)
brr(k, 2) = arr(x, 1)
brr(k, 3) = arr(i, 1)
brr(k, 4) = arr(i, y)

Next
End If
Next
Next

Sheets(2).[a1].Resize(k, 4) = brr

End Sub

shiruiqiang

Sub test()
Dim arr, brr(1 To 1000000, 1 To 4)

arr = Sheets(1).UsedRange
For y = 3 To UBound(arr, 2)
For x = 1 To UBound(arr) - 20
If InStr(arr(x, y), "公司") Then
For i = x + 3 To x + 19
k = k + 1
brr(k, 1) = arr(x, y)
brr(k, 2) = arr(x, 1)
brr(k, 3) = arr(i, 1)
brr(k, 4) = arr(i, y)

Next
End If
Next
Next

Sheets(2).[a1].Resize(k, 4) = brr

End Sub

蓝桥玄霜

整理的例子：

吴中泉

结果在sheet3

吴中泉

吴中泉 发表于 2023-5-31 19:49
结果在sheet3

可怜的孩子，给你个附件吧，不好用说一声
工作簿3.rar (35.21 KB, 下载次数: 9)

2023-5-31 19:52 上传

点击文件名下载附件

吴中泉

吴中泉 发表于 2023-5-31 19:49
结果在sheet3

审核这么慢，再来张

gwjkkkkk

参与一下。。。