Ребята, привет!
Помогите, плиз!
Необходимо сделать сводную таблицу из 2-х источников. Нашла здесь очень хороший макрос, только вот проблемка. На листах все столбцы с одинаковыми названиями, кроме столбцов с данными. На одном листе продажи, а втором - остатки. Как изменить макрос, чтоб он на сводной отображал и остатки и продажи?
На данный момент макрос суммирует данные продаж и остатка и именует столбец "продажи".
Sub Сводная_таблица()
Dim i As Long
Dim arSQL() As String
Dim objPivotCache As PivotCache
Dim objRS As Object
Dim ResultSheetName As String
Dim SheetsNames As Variant
'имя листа, куда будет выводиться результирующая сводная
ResultSheetName = "Сводная"
'массив имен листов с исходными таблицами
SheetsNames = Array("ВТОРИЧНЫЙ ФАКТ", "ОСТАТКИ")
'формируем кэш по таблицам с листов из SheetsNames
With ActiveWorkbook
ReDim arSQL(1 To (UBound(SheetsNames) + 1))
For i = LBound(SheetsNames) To UBound(SheetsNames)
arSQL(i + 1) = "SELECT * FROM [" & SheetsNames(i) & "$]"
Next i
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open Join$(arSQL, " UNION ALL "), _
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
Помогите, плиз!
Необходимо сделать сводную таблицу из 2-х источников. Нашла здесь очень хороший макрос, только вот проблемка. На листах все столбцы с одинаковыми названиями, кроме столбцов с данными. На одном листе продажи, а втором - остатки. Как изменить макрос, чтоб он на сводной отображал и остатки и продажи?
На данный момент макрос суммирует данные продаж и остатка и именует столбец "продажи".
Sub Сводная_таблица()
Dim i As Long
Dim arSQL() As String
Dim objPivotCache As PivotCache
Dim objRS As Object
Dim ResultSheetName As String
Dim SheetsNames As Variant
'имя листа, куда будет выводиться результирующая сводная
ResultSheetName = "Сводная"
'массив имен листов с исходными таблицами
SheetsNames = Array("ВТОРИЧНЫЙ ФАКТ", "ОСТАТКИ")
'формируем кэш по таблицам с листов из SheetsNames
With ActiveWorkbook
ReDim arSQL(1 To (UBound(SheetsNames) + 1))
For i = LBound(SheetsNames) To UBound(SheetsNames)
arSQL(i + 1) = "SELECT * FROM [" & SheetsNames(i) & "$]"
Next i
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open Join$(arSQL, " UNION ALL "), _
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
