Сложение 2-х таблиц из БД

[R Dmitry]

Сообщение от Dimarik163

Теперь ошибка 1004: Application-difined or object-defined error.

а первый рекордсет выводит на лист, данные?

вообщем приводите весь код, по образам гадать тяжело

[Sparkman]

Линки между базами есть?
Если да, то так:

select a.[№],a.[ФИО]
from Таблица1@Линк1 a
union
select b.[№],b.[ФИО]
from Таблица2@Линк2 b

[doober]

Я думаю,это должно спасти

Set rs = cn1.Execute(CommandText)
Set rs2 = cn2.Execute(CommandText)
R_Count=rs.RecordCount
Cells(1, 1).CopyFromRecordset rs
Cells(1 + R_Count, 1).CopyFromRecordset rs2

[Dimarik163]

Sub Макрос2()
 

Source1 = "ODBC;DSN=Комтранс;Driver=Firebird/InterBase(r) driver;Dbname=192.168.30.1:D:\program\ib\AVTOSALON.GDB;CHARSET=WIN1251;UID=NEVEROV;Role=R_SERVICE;"
Source2 = "ODBC;DSN=Масленикова;Driver=Firebird/InterBase(r) driver;Dbname=192.168.50.1:E:\program\ib\AVTOSALON.GDB;CHARSET=WIN1251;UID=NEVEROV;Role=R_SERVICE;"


CommandText = "SELECT SUM( WORKS.KOL ) , WORKERS.FIO  FROM WORKERS INNER JOIN WORKS ON (WORKERS.ID = WORKS.WORKER_ID) INNER JOIN SERVICE ON (WORKS.SERVICE_ID = SERVICE.ID)  WHERE ( (SERVICE.DATA_ISP BETWEEN '01.05.11' and '31.05.11')) GROUP BY WORKERS.FIO"
  
Set cn1 = CreateObject("ADODB.Connection")
Set cn2 = CreateObject("ADODB.Connection")

cn1.Open Source1
cn2.Open Source2

Set rs1 = cn1.Execute(CommandText)
Set rs2 = cn2.Execute(CommandText)

R_Count = rs1.RecordCount
Cells(1, 1).CopyFromRecordset rs1
Cells(1 + R_Count, 1).CopyFromRecordset rs2

rs1.Close
cn1.Close

rs2.Close
cn2.Close


End Sub

Первый рекордсет выводит данные на лист и если убрать строчку "Cells(1 + R_Count, 1).CopyFromRecordset rs2", то все проходит нормально.

Линка между базами нету.

R_Count=rs.RecordCount Не помогло:1004: Application-difined or object-defined error.

[doober]

Только одно объяснение-проблема с rs2
Если все нормально,он должен вывести на лист данные
Первый не выводите

Cells(1 , 1).CopyFromRecordset rs2

[Dimarik163]

Я так понимаю в моем случае RecordCount = -1
Если сделать Cells(2 + R_Count, 1).CopyFromRecordset rs2, то макрос завершается успешно, но при этом данные накладываются друг на друга.
Может бысть есть другой способ выгрузить данные?


Безымянный.JPG

[Dimarik163]

Сообщение от doober

Только одно объяснение-проблема с rs2
Если все нормально,он должен вывести на лист данные
Первый не выводите

Cells(1 , 1).CopyFromRecordset rs2

С rs2 все впорядке. Данные переносятся на лист.

[doober]

Тогда так

 Dim R_Count as Long

R_Count=rs1.RecordCount
If R_Count>0 then

Cells(1 , 1).CopyFromRecordset rs1
else
R_Count=0
end if

If rs2.RecordCount>0 then

Cells(1 + R_Count, 1).CopyFromRecordset rs2
end if

[Dimarik163]

Сообщение от doober

Тогда так

 Dim R_Count as Long

R_Count=rs1.RecordCount
If R_Count>0 then

Cells(1 , 1).CopyFromRecordset rs1
else
R_Count=0
end if

If rs2.RecordCount>0 then

Cells(1 + R_Count, 1).CopyFromRecordset rs2
end if

Тоже не работает. Ошибок нет, но и данных на листе нет.

[R Dmitry]

может в массив перегрузить

Sub Макрос2()
 
Dim arr()
Source1 = "ODBC;DSN=Комтранс;Driver=Firebird/InterBase(r) driver;Dbname=192.168.30.1:D:\program\ib\AVTOSALON.GDB;CHARSET=WIN1251;UID=NEVEROV;Role=R_SERVICE;"
Source2 = "ODBC;DSN=Масленикова;Driver=Firebird/InterBase(r) driver;Dbname=192.168.50.1:E:\program\ib\AVTOSALON.GDB;CHARSET=WIN1251;UID=NEVEROV;Role=R_SERVICE;"


CommandText = "SELECT SUM( WORKS.KOL ) , WORKERS.FIO  FROM WORKERS INNER JOIN WORKS ON (WORKERS.ID = WORKS.WORKER_ID) INNER JOIN SERVICE ON (WORKS.SERVICE_ID = SERVICE.ID)  WHERE ( (SERVICE.DATA_ISP BETWEEN '01.05.11' and '31.05.11')) GROUP BY WORKERS.FIO"
  
Set cn1 = CreateObject("ADODB.Connection")
Set cn2 = CreateObject("ADODB.Connection")

cn1.Open Source1
cn2.Open Source2

Set rs1 = cn1.Execute(CommandText)
Set rs2 = cn2.Execute(CommandText)
'на всякий случай пробежимся по рекордсету
rs1.MoveLast: rs1.MoveFirst
R_Count = rs1.RecordCount
Cells(1, 1).CopyFromRecordset rs1
Cells(1 + R_Count, 1).CopyFromRecordset rs2

'если не поможет ..... хотя должно раскоментируйте этот блок попробуем через массив
'rs2.MoveLast: rs2.MoveFirst
'arr = rs2.GetRows(rs2.RecordCount)
'arr = Application.Transpose(arr)
'Cells(1 + R_Count, 1).Resize(UBound(arr), UBound(arr, 2)) = arr

rs1.Close
cn1.Close

rs2.Close
cn2.Close


End Sub