提取数据

zhy8888256

求各位老师帮助怎样把表一中的数据提取到表二中红色数据？谢谢！

蓝桥玄霜

以后请上传表格附件。

太极拍天雄

练习做一个

zhy8888256

蓝桥玄霜 发表于 2023-1-13 10:16
以后请上传表格附件。

非常感谢！

zhy8888256

太极拍天雄 发表于 2023-1-13 10:39
练习做一个

非常感谢！

gwjkkkkk

Sub test()
     Dim ar, br, i&, r&
     
     ar = Sheets(1).UsedRange
     ReDim br(1 To UBound(ar), 1 To 3)
     
     For i = 1 To UBound(ar)
        If InStr(ar(i, 1), "项目") Then
           r = r + 1
           br(r, 1) = Split(ar(i, 1), "：")(1)
        ElseIf ar(i, 2) = "合计" Then
           br(r, 3) = ar(i, 5)
        End If
    Next i
   
    [A2].CurrentRegion.Offset(1).Clear
    [A3].Resize(r, 3) = br
    Beep
End Sub

gwjkkkkk

参与一下。。。

zhy8888256

gwjkkkkk 发表于 2023-1-13 18:58
Sub test()
     Dim ar, br, i&, r&
     

非常感谢！

zhy8888256

蓝桥玄霜 发表于 2023-1-13 10:16
以后请上传表格附件。

提示下标越界

nicleyuan

参与一下。