Добрый день. Не знает ли кто ответа на такой вопрос. Имеется книга в Excel, данные хранятся на разных листах в именованных областях. Возможно ли сделать выборку из разных областей аналогично SQL запросу и поместить результат в другой лист этой же книги. Можно конечно макросом перебирать записи на листах. Однако много областей и сцеплять их долго.
Точно знаю, что из внешней программы можно обращаться к именованным областям Экселевской книги через ODBC и выбирать данные как из таблиц (в Фоксе например).
А можно ли в самом Экселе сделать чтото типа :
select a.p1, Sum(b.p2) from Лист1, Лист2 where a.p3=b.p3

Спасибо за сответ. Но основной вопрос в том, чтобы select-ом объединить данные из нескольких (многочисленных) именованных диапазонов и поместить результат в другой диапазон.

Start Visual Basic and create a new Standard EXE project. Form1 is created by default.


Add a CommandButton to Form1.


Click References from the Project menu. Add a reference to the Microsoft ActiveX Data Objects 2.1 Library.


Paste the following code into the code section of Form1:



Private Sub Command1_Click()
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset

Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim recArray As Variant

Dim strDB As String
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer

' Set the string to the path of your Northwind database
strDB = "c:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb"

' Open connection to the database
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDB & ";"

' Open recordset based on Orders table
rst.Open "Select * From Orders", cnt

' Create an instance of Excel and add a workbook
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Sheet1")

' Display Excel and give user control of Excel's lifetime
xlApp.Visible = True
xlApp.UserControl = True

' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next

' Check version of Excel
If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
'EXCEL 2000 or 2002: Use CopyFromRecordset

' Copy the recordset to the worksheet, starting in cell A2
xlWs.Cells(2, 1).CopyFromRecordset rst
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets

Else
'EXCEL 97 or earlier: Use GetRows then copy array to Excel

' Copy recordset to an array
recArray = rst.GetRows
'Note: GetRows returns a 0-based array where the first
'dimension contains fields and the second dimension
'contains records. We will transpose this array so that
'the first dimension contains records, allowing the
'data to appears properly when copied to Excel

' Determine number of records recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
' Take care of OLE object fields or array fields
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'next record
Next iCol 'next field

' Transpose and Copy the array to the worksheet,
' starting in cell A2
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If ' Auto-fit the column widths and row heights
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit ' Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing

' Release Excel references
Set xlWs = Nothing
Set xlWb = Nothing Set xlApp = NothingEnd Sub
Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)

Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant

Xupper = UBound(v, 2)
Yupper = UBound(v, 1)

ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next Y
Next X

TransposeDim = tempArrayEnd Function

Press the F5 key to run the project. Form1 appears.


Click the CommandButton on Form1, and note that the contents of the Orders table is displayed in a new workbook in Excel.

спасибо за помощь, заработало через ADODB.Connection
Set oconnection = CreateObject("ADODB.Connection")
oconnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Trim(ActiveWorkbook.FullName) + ";Extended Properties=""Excel 8.0;HDR=NO"""

sqltext = "SELECT ....."
Set oRS = oconnection.Execute(sqltext)
With ActiveWorkbook.Worksheets("Rezult").QueryTables.Add(oRS, Destination:=Worksheets("Rezult").Range("A1"))
.Name = "Rezult1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With

Результат помещается в лист Rezult1 в именованный диапазон Rezult, а вот если запрос уже из него сделать то не выходит, пищет что объект Result1 не найден. причем в списке именованных областей его видно.