Сводная диаграмма для нескольких документов возвращает 0 как сумму, когда документ пуст

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

в конце, но результат тот же. В качестве обходного пути он работал для 0 всех строк в таблицах данных или для добавления псевдополя в начале, которое имеет значение 0 в качестве значения.

Есть ли возможность проверить с помощью запроса, является ли вся таблица emtpy, и вернуть значение, которое может понять excel?

спасибо!

Answer 1

reox,

Это довольно уродливо, но я думаю, что это работает. Он создает тестовую сводную кэш и сводную таблицу для каждой рабочей книги и добавляет книгу в 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