求复杂表格的数据提取

xiaoya6976

表格是软件里面导出来的，有固定格式，表格的层级结构是两层的，需要在目标提取表里面转换成多层级

数据样本.rar (21.15 KB, 下载次数: 13)

2024-7-6 10:43 上传

点击文件名下载附件

quqiyuan

参与一下，供参考。。。

quqiyuan

代码如下，仅供参考。。。
Sub test()
    arr = Sheet1.UsedRange
    ReDim brr(1 To UBound(arr), 1 To 6)
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If InStr(arr(i, 1), "工程名称") Then
            s = Split(arr(i, 1), "工程名称：")(1)
            If InStr(s, "【") Then
                ss = Split(s, "【")(0)
                sss = Replace(Split(s, "【")(1), "】", "")
                If Not d.exists(ss) Then
                    Set d(ss) = CreateObject("scripting.dictionary")
                    d(ss)(sss) = ""
                    n = n + 1
                    brr(n, 1) = WorksheetFunction.Text(d.Count, "[dbnum1]")
                    brr(n, 2) = ss
                    n = n + 1
                    brr(n, 1) = d(ss).Count
                    brr(n, 2) = sss
                End If
            ElseIf Not d(ss).exists(s) Then
                d(ss)(s) = ""
                n = n + 1
                brr(n, 1) = d(ss).Count
                brr(n, 2) = s
            End If
        ElseIf IsNumeric(arr(i, 1)) And Len(arr(i, 1)) <> 0 Then
            n = n + 1
            brr(n, 1) = d(ss).Count & "." & arr(i, 1)
            brr(n, 2) = arr(i, 3)
            brr(n, 3) = arr(i, 5)
            brr(n, 4) = arr(i, 6)
            brr(n, 5) = arr(i, 7)
            brr(n, 6) = arr(i, 8)
        End If
    Next
    Set d = Nothing
    With Sheet3
        .UsedRange.Clear
        .[a1].Resize(, 6) = [{"序号","项目名称","计量单位","工程量","综合单价","合价"}]
        .[a2].Resize(n, 6) = brr
        With .UsedRange
            .Borders.LineStyle = 1
            .HorizontalAlignment = xlCenter
            .Columns.AutoFit
        End With
        .Activate
    End With
    Beep
End Sub

cnmlgb9998

借楼练一下 PQ。


用PQ完美解决。因为数据太脏，清理好麻烦

不过，自己写完代码，自己都要佩服自己。ＲＥＰＬＡＣＥＶＡＬＵＥ 套ＲＥＰＬＡＣＥＶＡＬＵＥ,  ｇｒｏｕｐ　套 ｇｒｏｕｐ．

有没PQ大神帮我看看，我自学半年的成果！！！！！！！！

sunya_0529

WPS里的JSA练习一下——

wb_1027

VBA跑一圈就好了！

xiaoya6976

cnmlgb9998 发表于 2024-7-6 12:43
借楼练一下 PQ。

厉害，我现在VBA都没搞明白，整准备等10月底把执业考试弄完了，学一下PQ，因为工作涉及到很多数据的清洗和各种表格数据的提取