整理数据

孙明达

把坐标整理为右表的样式
B列编码有重复的，需要去重
表号都是唯一的，需要把表号按顺序提取到第一行
然后把表号对应编码的数据提取到相应的位置
我列举了三个表号的数据，分别用三种颜色做了标记，向大佬求助，详见附件

爱疯

Sub test()
    Application.ScreenUpdating = False
    Call test2
    Call DelPt(Sheets("step2"))
    Call AddPt(Sheets("step1").Range("a1").CurrentRegion, Sheets("step2").Range("a1"))
End Sub


'整理
Sub test2()
    Dim A, B(), i, j, r, s
    Sheets("源数据").Select
    A = Range("b2").CurrentRegion
    For i = 1 To UBound(A)
        If InStr(A(i, 2), "额") Then r = i    '更新字段行的行号
        If A(i, 1) <> "" Then
            For j = 5 To UBound(A, 2)
                If A(r, j) <> "" Then
                    s = s + 1
                    ReDim Preserve B(1 To 3, 1 To s)
                    B(1, s) = A(i, 1)
                    B(2, s) = A(r, j)
                    B(3, s) = A(i, j)
                End If
            Next j
        End If
    Next i

    Sheets("step1").Select
    Cells.Clear
    [a1].Resize(1, 3) = Array("字段1", "字段2", "字段3")
    B = Application.Transpose(B)
    [a2].Resize(UBound(B), UBound(B, 2)) = B
End Sub


'清除数据透视表
Sub DelPt(sh As Worksheet)
    Dim pt As PivotTable
    For Each pt In sh.PivotTables
        pt.TableRange2.Clear    '包括整个数据透视表（含页字段）的区域
    Next
End Sub


'添加数据透视表(透视表的源, 透视表的目标单元格)
Sub AddPt(x As Range, y As Range)
    Dim pc As PivotCache
    Dim pt As PivotTable
    Set pt = y.Parent.PivotTableWizard(xlDatabase, x, y)
    With pt
        .PivotFields("字段1").Orientation = xlRowField
        .PivotFields("字段2").Orientation = xlColumnField
        With .PivotFields("字段3")
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "0.000_ "
        End With
    End With
End Sub



整理数据2.rar (39.39 KB, 下载次数: 2)

2020-4-1 09:40 上传

点击文件名下载附件
是这样吗

孙明达

爱疯 发表于 2020-4-1 09:40
Sub test()
    Application.ScreenUpdating = False
    Call test2

结果是对的，谢谢大佬了，有一次性直接达到效果的方法吗？

爱疯

一次性的意思，是不要中间表"step1"吗？
因为透视表必然存在对应的数据源，这里这个源就是step1表。
如果再出处理：删除中间表，以及把数据透视表粘贴为值
收益不大，反倒隐患可能变大：代码变多，查看不便，也不便于以后的修改或扩展


隐藏中间表可以吗？

爱疯

只改下test


Sub test()
    Application.ScreenUpdating = False
    With Sheets("step1")
        .Visible = xlSheetVisible
        Call test2
        Call DelPt(Sheets("step2"))
        Call AddPt(Sheets("step1").Range("a1").CurrentRegion, Sheets("step2").Range("a1"))
        .Visible = xlSheetHidden
    End With
End Sub

孙明达

爱疯 发表于 2020-4-1 10:27
只改下test

已经非常感谢版主大大了，辛苦了