Страницы: 1
RSS
Сводная по нескольким диапазонам с разных листов
 
Добрый день!  
В приемах есть отличный пример как из нескольких листов сделать одну сводную таблицу.  
Проблема в том что макрос перебирает листы и не выбирает весь массив данных (делает это как то произвольно!)  
можно это исправить?  
ссылка по теме    
http://www.planetaexcel.ru/tip.php?aid=233  
 
рабочий макрос от Романа 22.03.2011    
Я не знаю где искать проблему.  
PS файл не выкладываю...> 100mb  
 
Sub New_Multi_Table_Pivot()  
Dim i As Long  
Dim arSQL() As String  
Dim objPivotCache As PivotCache  
Dim objRS As Object  
Dim ResultSheetName As String  
Dim SheetsNames As String  
Dim sh As Integer  
 
ResultSheetName = ActiveSheet.Name  
 
For sh = 2 To ActiveWorkbook.Sheets.Count  
SheetsNames = SheetsNames & "SELECT * FROM [" & Sheets (sh).Name & "$] UNION ALL "
Next sh  
SheetsNames = Trim(SheetsNames)  
SheetsNames = Left(SheetsNames, Len(SheetsNames) - 10)  
 
With ActiveWorkbook  
Set objRS = CreateObject("ADODB.Recordset")  
objRS.Open SheetsNames, _  
Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _  
.FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)  
End With  
On Error Resume Next  
Application.DisplayAlerts = False  
Worksheets(ResultSheetName).Delete  
Set wsPivot = Worksheets.Add  
wsPivot.Name = ResultSheetName  
 
Set objPivotCache = ActiveWorkbook.PivotCaches.Add(xlExternal)  
Set objPivotCache.Recordset = objRS  
Set objRS = Nothing  
With wsPivot  
objPivotCache.CreatePivotTable TableDestination:=wsPivot.Range("A3")  
Set objPivotCache = Nothing  
Range("A3").Select  
End With  
 
End Sub.
Страницы: 1
Наверх