excel 根据数据透视表在工作表中的物理顺序获取数据透视表名称

qxsslcnc  于 2023-05-19  发布在  其他
关注(0)|答案(1)|浏览(149)

Excel主表

如图所示,Excel工作表上有一些数据透视表。虽然它们被命名为PivotTable1到PivotTable11,但它们在工作表中的物理顺序并不相同。我想按照透视表在工作表中的物理顺序获取透视表的名称。
我试过使用ChatGPT,但它无法帮助。这是一个更大的项目的一部分,其中有数百个数据透视表。任何人都可以用VBA代码来做同样的事情吗?
我来搞定

但我想要这个

法典

Sub GetPivotTableRange()
    'GetPivotTableRange
    Dim pt As PivotTable
    Dim ptRange As Range
    Dim ptName As String
    
    'Loop through all the PivotTables in the active worksheet
    For Each pt In ActiveSheet.PivotTables
        'Get the PivotTable name and range
        ptName = pt.Name
        Set ptRange = pt.TableRange1
        
        'Display the range in the desired format
        Range(ptRange.Cells(1, 1), ptRange.Cells(1, ptRange.Columns.Count)).Select
        Dim rangeAddress As String
        rangeAddress = ActiveWindow.Selection.Address
        rangeAddress = Replace(rangeAddress, "$", "")
        rangeAddress = Replace(rangeAddress, ":", ":")
        rangeAddress = Replace(rangeAddress, "1", "")
        rangeAddress = Replace(rangeAddress, "2", "")
        rangeAddress = Replace(rangeAddress, "3", "")
        rangeAddress = Replace(rangeAddress, "4", "")
        rangeAddress = Replace(rangeAddress, "5", "")
        rangeAddress = Replace(rangeAddress, "6", "")
        rangeAddress = Replace(rangeAddress, "7", "")
        rangeAddress = Replace(rangeAddress, "8", "")
        rangeAddress = Replace(rangeAddress, "9", "")
        rangeAddress = Replace(rangeAddress, "0", "")
        
        'Display the PivotTable name and range address
        Debug.Print ptName & "= " & rangeAddress
    Next pt

End Sub
lnlaulya

lnlaulya1#

试试这个:它将所有Pivottables及其最左边的列号收集到一个Collection中,然后根据列号对该集合进行排序。

Sub ListPivotTables()
    Dim pt As PivotTable, ptRange As Range, ptName As String
    Dim col As New Collection, el
    
    'collect all the PT on the sheet
    Debug.Print vbLf & "Unsorted:"
    For Each pt In ActiveSheet.PivotTables
        col.Add Array(pt, pt.TableRange1.Cells(1).Column)
        Debug.Print pt.Name & "= " & _
                    pt.TableRange1.EntireColumn.Address(False, False)
    Next pt
    
    SortCollection col, 2   'sort the collection on the second element (column#)
    
    'print out the sorted PT
    Debug.Print vbLf & "Sorted:"
    For Each el In col
        Set pt = el(0)
        Debug.Print pt.Name & "= " & _
                    pt.TableRange1.EntireColumn.Address(False, False)
    Next el

End Sub

'Sort a collection of 0-based arrays in ascending order by the n'th element of each array
'Adapted from https://stackoverflow.com/a/3588073/478884
Sub SortCollection(col As Collection, n As Long, Optional AscendingSort As Boolean = True)
    Dim i As Long, j As Long, vTemp As Variant, v1, v2
    For i = 1 To col.Count - 1 'Two loops to bubble sort
        For j = i + 1 To col.Count
            v1 = col(i)(n - 1)
            v2 = col(j)(n - 1)
            If IIf(AscendingSort, v1 > v2, v1 < v2) Then
                vTemp = col(j)
                col.Remove j
                col.Add Item:=vTemp, before:=i
            End If
        Next j
    Next i
End Sub

相关问题