Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
760 views
in Technique[技术] by (71.8m points)

excel - PivotTable ShowDetail VBA choose only selected columns in SQL style

While showing details of pivottable with VBA method:

Range("D10").ShowDetail = True

I would like to choose only the columns I want, in a specified order I want. Let's say in source data of pivot table I have 10 columns (col1, col2, col3, ... , col10), and while expanding details with VBA I want to show just 3 columns (col7, col2, col5).

Is it possible to do it in SQL style like:

SELECT col7, col2, col5 from Range("D10").ShowDetail
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

I tuned this as a function so that you can get the sheet reference like this

Set DetailSheet = test_Przemyslaw_Remin(Range("D10"))

Here is the function :

Public Function test_Przemyslaw_Remin(RangeToDetail As Range) As Worksheet
Dim Ws As Worksheet

RangeToDetail.ShowDetail = True
Set Ws = ActiveSheet

Ws.Range("A1").Select
Ws.Columns("H:J").Delete
Ws.Columns("F:F").Delete
Ws.Columns("C:D").Delete
Ws.Columns("A:A").Value = Ws.Columns("D:D").Value
Ws.Columns("D:D").Clear

Set test_Przemyslaw_Remin = Ws
End Function

Solution with Headers' names

Results will be shown in the order set in the string in the ScanHeaders function

Public Sub SUB_Przemyslaw_Remin(RangeToDetail As Range)
    Dim Ws As Worksheet, _
        MaxCol As Integer, _
        CopyCol As Integer, _
        HeaD()

    RangeToDetail.ShowDetail = True
    Set Ws = ActiveSheet

    HeaD = ScanHeaders(Ws, "HeaderName1/HeaderName2/HeaderName3")
    For i = LBound(HeaD, 1) To UBound(HeaD, 1)
        If HeaD(i, 2) > MaxCol Then MaxCol = HeaD(i, 2)
    Next i


    With Ws
        .Range("A1").Select
        .Columns(ColLet(MaxCol + 1) & ":" & ColLet(.Columns.Count)).Delete
        'To start filling the data from the next column and then delete what is before
        CopyCol = MaxCol + 1
        For i = LBound(HeaD, 1) To UBound(HeaD, 1)
            .Columns(ColLet(CopyCol) & ":" & ColLet(CopyCol)).Value = _
                .Columns(HeaD(i, 3) & ":" & HeaD(i, 3)).Value
            CopyCol = CopyCol + 1
        Next i
        .Columns("A:" & ColLet(MaxCol)).Delete
    End With
End Sub

The scan headers function, that will return a array with in row : Header's Name, Column number, Column letter :

Public Function ScanHeaders(aSheet As Worksheet, Headers As String, Optional Separator As String = "/") As Variant
Dim LastCol As Integer, _
    ColUseName() As String, _
    ColUse()
ColUseName = Split(Headers, Separator)
ReDim ColUse(1 To UBound(ColUseName) + 1, 1 To 3)

For i = 1 To UBound(ColUse)
    ColUse(i, 1) = ColUseName(i - 1)
Next i

With Sheets(SheetName)
    LastCol = .Cells(1, 1).End(xlToRight).Column
    For k = LBound(ColUse, 1) To UBound(ColUse, 1)
        For i = 1 To LastCol
            If .Cells(1, i) <> ColUse(k, 1) Then
                If i = LastCol Then MsgBox "Missing data : " & ColUse(k, 1), vbCritical, "Verify data integrity"
            Else
                ColUse(k, 2) = i
                Exit For
            End If
        Next i
        ColUse(k, 3) = ColLet(ColUse(k, 2))
    Next k
End With
ScanHeaders = ColUse
End Function

And the function to get the Column's letter from the Column's number :

Public Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
    ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...