数据透视表显示详细信息VBA仅选择SQL样式中所选列 [英] PivotTable ShowDetail VBA choose only selected columns in SQL style

问题描述

  Range（D10）。ShowDetail = True 
  

我想按照我想要的指定顺序选择我想要的列。假设在数据透视表的源数据中，我有10列（col1，col2，col3，...，col10），并且在使用VBA扩展细节的时候，我只想显示3列（col7，col2，col5）。

是否可以像以下SQL样式那样执行：

 选择col7，col2，col5从Range（D10）。ShowDetail 
  

解决方案>

是的，我终于做到了。这个三个子集的集合允许您在数据透视表上使用 ShowDetail 创建SQL语句。

运行 Range（D10）后ShowDetail = True 运行宏 HereIsHowToUseIt
只需根据您的需要调整SQL：

选择[Col7]，[Col2]，[ Col5] from [DetailsTable] where [Col7] not null
只要离开 [DetailsTable] 就可以了。它将自动更改为具有详细数据的ActiveSheet。

调用子 DeleteAllWhereColumnIsNotNull 是可选的。此方法与SQL中的 WHERE列不为空相同，但它保证键列不会丢失其格式。您的格式是从前八行读取的，它将变成文本，即如果在第一行中有NULL。关于ADO格式化的更多信息，您可能会发现这里。

您不必使用宏启用对ActiveX库的引用。重要的是要分发您的文件。

您可以尝试使用不同的连接字符串。有三种不同的情况。他们都为我工作。

  Sub HereIsHowToUseIt（）
调用DeleteAllWhereColumnIsNotNull（Col7）'阻止格式化问题
 
'在SQL语句中使用from [DetailsTable]
 Dim SQL As String 
 SQL =从[DetailsTable]中选择[Col7]，[Col2]，[Col5]其中[Col7]不是null order by 1 desc'<  - 这里你的SQL代码
调用SelectFromDetailsTable（SQL）
 End Sub 
 
 Sub SelectFromDetailsTable（ByVal SQL As String）
 Application.Calculation = xlCalculationManual 
 Application.EnableEvents = False 
 
 ActiveSheet.UsedRange.Select'这个愚蠢的行被证明是至关重要的。如果你评论它，那么你可能会收到错误oRS.Open 
 
 Dim InputSheet，OutputSheet As Worksheet 
设置InputSheet = ActiveSheet 
 Worksheets.Add 
 DoEvents 
设置OutputSheet = ActiveSheet 
 
'新工作表上没有ListObject表。以防万一你想使用它为不同的目的删除旧表
如果不是OutputSheet.Cells（1，1）.ListObject是没有然后
 OutputSheet.Cells（1，1）.ListObject.Delete 
 End If 
 OutputSheet.Cells.ClearContents'它从来没有出生过，它已经很久没有了，但是如果再次重新启动
 
 Dim oCn As Object 
 Set oCn = CreateObject（ADODB.Connection）
 Dim cmd As Object 
设置cmd = CreateObject（ADODB.Command）
 Dim oRS As Object 
设置oRS = CreateObject（ ADODB.Recordset）
 
 Dim strFile As String 
 strFile = ThisWorkbook.FullName 
 
'-------选择任何你喜欢的连接字符串，所有这些都工作得很好----- 
 Dim ConnString As String 
 ConnString =Provider = MSDASQL.1; DSN = Excel Files; DBQ =& strFile& HDR =是; 'works good 
'ConnString =Provider = Microsoft.ACE.OLEDB.12.0; Data Source =& strFile& ;扩展属性=Excel 12.0; HDR =是; IMEX = 1; 'IMEX = 1 data as text 
'ConnString =Provider = Microsoft.Jet.OLEDB.4.0; excel 8.0; DATABASE =& strFile'works good 
'ConnString =Driver = {Microsoft Excel Driver（* .xls，* .xlsx，* .xlsm，* .xlsb）}; DBQ =& strFile'工程好
 Debug.Print ConnString 
 
 oCn.ConnectionString = ConnString 
 oCn.Open 
 
'Dim SQL As String 
 SQL = Replace（SQL，[DetailsTable]，[& InputSheet.Name&$]）
 Debug.Print SQL 
 
 oRS.Source = SQL 
 oRS.ActiveConnection = oCn 
 oRS.Open 
 
 OutputSheet.Activate 
'MyArray = oRS.GetRows 
'Debug.Print MyArray 
 
'-----方法1.从OpenRowSet复制到范围---------- 
对于intFieldIndex = 0到oRS.Fields.Count  -  1 
 OutputSheet.Cells（1 ，intFieldIndex + 1）.Value = oRS.Fields（intFieldIndex）.Name 
 Next intFieldIndex 
 OutputSheet.Cells（2，1）.CopyFromRecordset oRS 
 ActiveSheet.ListObjects.Add（xlSrcRange，Application .ActiveSheet.UsedRange，，xlYes）.Name =MyTable
'ActiveSheet.ListObjects（1）.Range.EntireColumn.AutoFit 
 ActiveSheet.UsedRange.EntireColumn.AutoFit 
 
'-----方法2.从OpenRowSet复制到表---------- 
'此方法吸吮，因为它不会阻止丢失格式
'Dim MyListObject As ListObject 
'Set MyListObject = OutputSheet.ListObjects.Add（SourceType：= xlSrcExternal，_ 
'Source：= oRS，LinkSource：= True，_ 
'TableStyleName：= xlGuess，destination：= OutputSheet。单元格（1，1））
'MyListObject.Refresh 
 
如果oRS.State<> adStateClosed然后oRS.Close 
如果不是oRS是没有，然后设置oRS =没有
如果不是oCn是没有，然后设置oCn =没有
 
'删除未使用的ADO连接
 Dim conn As WorkbookConnection 
对于每个conn在ActiveWorkbook.Connections 
 Debug.Print conn.Name 
如果conn.Name像Connection％那么conn.Delete'在本地语言中，默认连接名称可能不同
 Next conn 
 
 Application.Calculation = xlCalculationAutomatic 
 Application.EnableEvents = True 
 End Sub 
 
 Sub DeleteAllWhereColumnIsNotNull（ColumnName As String）
 Dim RngHeader As Range 
 Debug.Print ActiveSheet.ListObjects（1）.Name& [[#Headers]，[& ColumnName& ]]
 Set RngHeader = Range（ActiveSheet.ListObjects（1）.Name&[[#Headers]，[& ColumnName&]]）
 Debug.Print RngHeader .Column 
 Dim ColumnNumber 
 ColumnNumber = RngHeader.Column 
 
 ActiveSheet.ListObjects（1）.Sort.SortFields.Clear 
 ActiveSheet.ListObjects（1）.HeaderRowRange（ ColumnNumber）.Interior.Color = 255 
 ActiveSheet.ListObjects（1）.ListColumns（ColumnNumber）.DataBodyRange.NumberFormat =＃，## 0.00
 
 With ActiveSheet.ListObjects（1） .Sort 
使用.SortFields 
 .Clear 
'.Add ActiveSheet.ListObjects（1）.HeaderRowRange（ColumnNumber），SortOn：= xlSortOnValues，Order：= sortuj 
 .Add RngHeader ，SortOn：= xlSortOnValues，Order：= xlAscending 
 End with 
 .Header = xlYes 
 .MatchCase = False 
 .Orientation = xlTopToBottom 
 .SortMethod = xlPinYin 
。应用
结束
 
'Dele te从DetailsTable其中[ColumnName]为空
 On Error Resume Next'如果没有NULL单元格，只需跳到下一行
 ActiveSheet.ListObjects（1）.ListColumns（ColumnNumber）.DataBodyRange.SpecialCells（ xlCellTypeBlanks）.EntireRow.Delete 
 Err.Clear 
 
 ActiveSheet.UsedRange.Select'这个愚蠢的事情被证明是至关重要的。如果您发表评论，那么您将收到与Recordset Open有关的错误
 End Sub 
  

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

解决方案

Yes, I have finally done it. This collection of three subs allows you make SQL statements on just used ShowDetail on PivotTable.

After running Range("D10").ShowDetail = True run macro HereIsHowToUseIt Just adjust the SQL according to your needs:

select [Col7],[Col2],[Col5] from [DetailsTable] where [Col7] is not null Just leave [DetailsTable] as it is. It will be changed automatically into ActiveSheet with details data.

Calling the sub DeleteAllWhereColumnIsNotNull is optional. This approach is the same as WHERE Column is not null in SQL but it guarantees that the key column will not lose its formatting. Your formatting is read from the first eight rows and it will be turned into text i.e. if you have NULLs in the first rows. More about corrupt formatting of ADO you may find here.

You do not have to enable references to ActiveX libraries using the macros. It is important if you want to distribute your files.

You may experiment with different connection strings. There are three different left just in case. All of them worked for me.

Sub HereIsHowToUseIt()
    Call DeleteAllWhereColumnIsNotNull("Col7")  'To prevent formatting issues

    'In the SQL statement use "from [DetailsTable]"
    Dim SQL As String
    SQL = "select [Col7],[Col2],[Col5] from [DetailsTable] where [Col7] is not null order by 1 desc" '<-- Here goes your SQL code
    Call SelectFromDetailsTable(SQL)
End Sub

Sub SelectFromDetailsTable(ByVal SQL As String)
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ActiveSheet.UsedRange.Select 'This stupid line proved to be crucial. If you comment it, then you may get error in line oRS.Open

    Dim InputSheet, OutputSheet As Worksheet
    Set InputSheet = ActiveSheet
    Worksheets.Add
    DoEvents
    Set OutputSheet = ActiveSheet

    'There is no ListObject table on new sheet. Just in case you want to use it for different purpose remove old table
    If Not OutputSheet.Cells(1, 1).ListObject Is Nothing Then
        OutputSheet.Cells(1, 1).ListObject.Delete
    End If
    OutputSheet.Cells.ClearContents 'It has never been born, it is long gone, but just in case kick it again

    Dim oCn As Object
    Set oCn = CreateObject("ADODB.Connection")
    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")
    Dim oRS As Object
    Set oRS = CreateObject("ADODB.Recordset")

    Dim strFile As String
    strFile = ThisWorkbook.FullName

    '------- Choose whatever connection string you like, all of them work well -----
    Dim ConnString As String
    ConnString = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & strFile & ";HDR=Yes';"   'works good
    'ConnString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"        'IMEX=1 data as text
    'ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;excel 8.0;DATABASE=" & strFile 'works good
    'ConnString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & strFile    'works good
    Debug.Print ConnString

    oCn.ConnectionString = ConnString
    oCn.Open

    'Dim SQL As String
    SQL = Replace(SQL, "[DetailsTable]", "[" & InputSheet.Name & "$] ")
    Debug.Print SQL

    oRS.Source = SQL
    oRS.ActiveConnection = oCn
    oRS.Open

    OutputSheet.Activate
    'MyArray = oRS.GetRows
    'Debug.Print MyArray

    '----- Method 1. Copy from OpenRowSet to Range ----------
    For intFieldIndex = 0 To oRS.Fields.Count - 1
        OutputSheet.Cells(1, intFieldIndex + 1).Value = oRS.Fields(intFieldIndex).Name
    Next intFieldIndex
    OutputSheet.Cells(2, 1).CopyFromRecordset oRS
    ActiveSheet.ListObjects.Add(xlSrcRange, Application.ActiveSheet.UsedRange, , xlYes).Name = "MyTable"
    'ActiveSheet.ListObjects(1).Range.EntireColumn.AutoFit
    ActiveSheet.UsedRange.EntireColumn.AutoFit

    '----- Method 2. Copy from OpenRowSet to Table ----------
    'This method sucks because it does not prevent losing formatting
    'Dim MyListObject As ListObject
    'Set MyListObject = OutputSheet.ListObjects.Add(SourceType:=xlSrcExternal, _
    'Source:=oRS, LinkSource:=True, _
    'TableStyleName:=xlGuess, destination:=OutputSheet.Cells(1, 1))
    'MyListObject.Refresh

    If oRS.State <> adStateClosed Then oRS.Close
    If Not oRS Is Nothing Then Set oRS = Nothing
    If Not oCn Is Nothing Then Set oCn = Nothing

    'remove unused ADO connections
    Dim conn As WorkbookConnection
    For Each conn In ActiveWorkbook.Connections
        Debug.Print conn.Name
        If conn.Name Like "Connection%" Then conn.Delete 'In local languages the default connection name may be different
    Next conn

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Sub DeleteAllWhereColumnIsNotNull(ColumnName As String)
    Dim RngHeader As Range
    Debug.Print ActiveSheet.ListObjects(1).Name & "[[#Headers],[" & ColumnName & "]]"
    Set RngHeader = Range(ActiveSheet.ListObjects(1).Name & "[[#Headers],[" & ColumnName & "]]")
    Debug.Print RngHeader.Column
    Dim ColumnNumber
    ColumnNumber = RngHeader.Column

    ActiveSheet.ListObjects(1).Sort.SortFields.Clear
    ActiveSheet.ListObjects(1).HeaderRowRange(ColumnNumber).Interior.Color = 255
    ActiveSheet.ListObjects(1).ListColumns(ColumnNumber).DataBodyRange.NumberFormat = "#,##0.00"

    With ActiveSheet.ListObjects(1).Sort
         With .SortFields
            .Clear
            '.Add ActiveSheet.ListObjects(1).HeaderRowRange(ColumnNumber), SortOn:=xlSortOnValues, Order:=sortuj
            .Add RngHeader, SortOn:=xlSortOnValues, Order:=xlAscending
        End With
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Delete from DetailsTable where [ColumnName] is null
    On Error Resume Next 'If there are no NULL cells, just skip to next row
    ActiveSheet.ListObjects(1).ListColumns(ColumnNumber).DataBodyRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Err.Clear

    ActiveSheet.UsedRange.Select 'This stupid thing proved to be crucial. If you comment it, then you will get error with Recordset Open
End Sub

这篇关于数据透视表显示详细信息VBA仅选择SQL样式中所选列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！