Question

我有多个Excel文档和数据透视图的奇怪问题：我使用此报告文档来获取多个Excel工作表的信息：http://blog.contextures.com/archives/2010/08/30/macro-creates-excel-pivot-table-from-multiple-files/ 问题是，如果我的一个文件实际上没有数据，我的数据透视图的结果是完全0！我尝试使用

调整查询

 `table" & i & "` WHERE `table" & i & "`.`Stunden` != 0

或

 `table" & i & "` WHERE `table" & i & "`.`Stunden` IS NOT NULL

最后，但结果相同。作为workarround，它工作在数据表中的所有行，或者在开头添加一个伪值为0的值。

如果整个表格是emtpy并返回一个excel可以理解的值，那么有没有可以查询查询？

谢谢！

Answer 1

再氧化，

这很难看，但我觉得它很有效。它为每个工作簿创建一个测试pivotcache和pivottable，并且只有在测试数据透视缓存中至少有记录时才将工作簿添加到SQL。你可以用DAO做些更短的事情。

Sub MergeFiles()
    Dim PT As Excel.PivotTable
    Dim PC As Excel.PivotCache
    Dim strConTest As String
    Dim pcTest As Excel.PivotCache
    Dim ptTest As Excel.PivotTable
    Dim boolSheetHasRecords As Boolean
    Dim strSQLTest As String
    Dim arrFiles As Variant
    Dim strSheet As String
    Dim strPath As String
    Dim strSQL As String
    Dim strCon As String
    Dim rng As Range
    Dim i As Long

    strPath = CurDir
    ChDirNet ThisWorkbook.Path

    arrFiles = Application.GetOpenFilename("Excel Workbooks (*.xls), *.xls", , , , True)
    strSheet = "Sheet1"

    If Not IsArray(arrFiles) Then Exit Sub

    Application.ScreenUpdating = False

    If Val(Application.Version) > 11 Then DeleteConnections_12

    Set rng = ThisWorkbook.Sheets(1).Cells
    rng.Clear
    For i = 1 To UBound(arrFiles)
        strConTest = _
        "ODBC;" & _
        "DSN=Excel Files;" & _
                     "DBQ=" & arrFiles(i) & ";" & _
                     "DefaultDir=" & "" & ";" & _
                     "DriverId=790;" & _
                     "MaxBufferSize=2048;" & _
                     "PageTimeout=5"
        Set pcTest = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
        strSQLTest = "SELECT * FROM `" & arrFiles(i) & "`.[" & strSheet & "$]"
        With pcTest
            .Connection = strConTest
            .CommandType = xlCmdSql
            .CommandText = strSQLTest
            Set rng = ThisWorkbook.Sheets(1).Cells
            rng.Clear
            Set ptTest = .CreatePivotTable(TableDestination:=rng(6, 1))
            If pcTest.RecordCount > 0 Then
                boolSheetHasRecords = True
                Else
                boolSheetHasRecords = False
            End If
        End With
        Set ptTest = Nothing
        Set pcTest = Nothing
        If boolSheetHasRecords Then
            If strSQL = "" Then
                strSQL = "SELECT * FROM `" & arrFiles(i) & "`.[" & strSheet & "$]"
            Else
                strSQL = strSQL & " UNION ALL SELECT * FROM `" & arrFiles(i) & "`.[" & strSheet & "$]"
            End If
        End If
    Next i
    If strSQL <> "" Then
        strCon = _
        "ODBC;" & _
                 "DSN=Excel Files;" & _
                 "DBQ=" & arrFiles(1) & ";" & _
                 "DefaultDir=" & "" & ";" & _
                 "DriverId=790;" & _
                 "MaxBufferSize=2048;" & _
                 "PageTimeout=5"
        Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
        With PC
            .Connection = strCon
            .CommandType = xlCmdSql
            .CommandText = strSQL
            Set rng = ThisWorkbook.Sheets(1).Cells
            rng.Clear
            Set PT = .CreatePivotTable(TableDestination:=rng(6, 1))
        End With
        With PT
            With .PivotFields(1)                            'Rep
                .Orientation = xlRowField
                .Position = 1
            End With
            .AddDataField .PivotFields(8), "Sales", xlSum   'Total
            With .PivotFields(3)                            'Region
                .Orientation = xlPageField
                .Position = 1
            End With
            With .PivotFields(2)                            'Date
                .Orientation = xlColumnField
                .Position = 1
                .DataRange.Cells(1).Group _
                        Start:=True, _
                        End:=True, _
                        Periods:=Array(False, False, False, False, True, False, True)
            End With
        End With
    End If
    'Clean up
    Set PT = Nothing
    Set PC = Nothing

    ChDirNet strPath
    Application.ScreenUpdating = True
    End Sub

当文档为空时，多个Documents上的PivotChart返回0作为总和

1 个答案: