麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 兩個獨立EXCEL 如何將運算完的資料回傳到主Excel? [打印本頁]

作者: 502243 時間: 2019-3-12 11:39 標題: 兩個獨立EXCEL 如何將運算完的資料回傳到主Excel?

各位前輩們大家好，
疑問發生如下：
搭配下圖
1.開始鈕跟停止鈕都在A.xlsm裡..新開啟一個獨立的excel代碼如下..但就沒辦法引用相關新物件excel的屬性與方法

代碼要如何寫才能引用控制excel2.exe呢….

Sub newexcel()
Dim xlapp As Object
Dim xlbook As Object

      Set xlapp = CreateObject("Excel.Application")
   Set xlbook = xlapp.Workbooks.Open("D:\Excel VBA\A.xlsm")

‘這邊能否CALL  副程式?

      xlapp.Workbooks(“A”).Close SaveChanges:=False ‘
      xlapp.Quit

   '  Set xlbook = Nothing
   '  Set xlapp = Nothing
End Sub
爬文找了很久..只找到很多雷同上面一段..
還請大大指點一下….
[attach]30217[/attach][attach]30218[/attach][attach]30219[/attach]

作者: zheng211016 時間: 2019-3-12 22:51

本帖最後由 zheng211016 於 2019-3-12 22:53 編輯

第1 : 請你先看清楚你的問題很多矛盾到底是要在C.xlsm運算還是B.xlsm? p.s 我用b.xlsm
第2 : 大於5的值並沒有5 p.s 篩選必須有個標題所以我貼在A2做篩選
第3 : 結果要貼到A.xlsm 工作表1的哪裡? p.s 我貼A.xlsm 的 D1

下圖檔案位置請自行更改

[attach]30222[/attach]

[attach]30221[/attach]

作者: 502243 時間: 2019-3-12 23:24

回復 2# zheng211016

感謝zheng211016大大的指教:
1.運算的確是在C.xlsm....因為如果是在同一層excel1.exe裡面處理,這方面的程式我都寫好了
難在新開一個excel2.exe裡面處理後資料回傳..與結束鈕在A.xlsm裡..相關的引用語法我鑽研不出來
2.這邊是小弟筆誤..再C.xlsm D欄多打一個5...造成大家的誤會不好意思..
3.這邊我漏打 ..貼在A.xlsm裡面都可以
[attach]30223[/attach]
ps:因為我程式碼挺多的.所以這邊是大概說明一下方向.
還請各位前輩指點一下...

作者: Scott090 時間: 2019-3-13 06:17

回復 1# 502243

參考一下這裡也許有幫助：
http://forum.twbts.com/viewthrea ... a=pageD1&page=2

作者: 502243 時間: 2019-3-13 07:49

回復 4# Scott090

感謝前面兩位前輩指點..
這篇我也有注意到....我目前都是鑽研這篇其中得語法..
來繼續撰寫...............只是過程中一直..叮咚叮咚.......
然後還在找相關的文獻...

作者: Scott090 時間: 2019-3-13 09:00

回復 5# 502243

      澄清確認一下：
      Sub newexcel() 這一段程序碼是寫在 Excel2Application.C.xlsm
      叫入 Excel1Application.A.xlsm，然後要到 A.xlsm 執行在A.xlsm 裡面的程式碼( 如按鈕在 A 工作表)，
      用 A 的程式碼把 A 的資料拿到 C 工作表去處理、處理完的資料拿回 A。
      流程回到 C.xlsm 把 A.xlsm 關閉。
      A、C  是2個獨立的物件。

      是這樣嗎?

作者: 502243 時間: 2019-3-13 10:37

回復 6# Scott090

剛好相反耶…相關的流程圖如新圖所示….
[attach]30224[/attach][attach]30225[/attach]
A.xlsm 裡面的程式碼應該只會有:
開始鈕
Sub newexcel()
Dim xlapp As Object
      Set xlapp = CreateObject("Excel.Application") '建立一個新的excel程式
      Set xlbook = xlapp.Workbooks.Open("D:\Excel VBA\c.xlsm") '用excel開啟活頁簿
         xlapp.Visible = True 'excel可以看見
'''''''''' '後面還在撰寫中

End Sub

結束鈕
Sub newexcelclose()

C.xlsm裡面的程式碼:
接收A.xlsm裡面資料
處理資料
回傳資料到A

只是運算與回傳的程式碼的部分
我還在構思要寫在哪個裡面比較洽當….

作者: Scott090 時間: 2019-3-13 10:59

回復 7# 502243

所以版主的訴求是  A  專案程式碼呼叫 C 專案內的程式碼?
   可以參考本論壇：
         http://forum.twbts.com/thread-5960-1-1.html
                     如何用巨集呼叫巨集
                     呼叫不同專案的程序   Run "123.XLS!A01.MAIN"

   或，其他網址
            https://samlifebox.blogspot.com/2015/02/macro-macro.html
                     Excel 之 macro 呼叫 macro

   A、C 是不同的Excel.Application物件，改一改也許可行

作者: GBKEE 時間: 2019-3-13 14:13

本帖最後由 GBKEE 於 2019-3-13 14:15 編輯

回復 7# 502243
試試看

'****A.xlsm 裡面
'**物件類別模組 Class1 的程式碼
Option Explicit
Public WithEvents App As Application
Property Set T_APP(p As Application)
Set App = p '物件類別導入物件
App.Visible = True
End Property

複製代碼

'A.xlsm
'一般 Module1 的程式碼
Option Explicit
Public xApp As New Class1
Public Ap As Object
Private Sub Ex_開始()
Set Ap = New Application
Set xApp.T_APP = Ap
Ap.Workbooks.Open (ThisWorkbook.Path & "\C.XLSM")
'** 請修正為正確檔案名稱***
End Sub
Sub Ex_newexcel()
Dim AR As Variant, Rng As Range, E As Range
With ThisWorkbook.Sheets(1) '指名A檔下
Set Rng = .Range("A1", .Range("A1").End(xlDown))
End With
AR = Rng.Value 'A檔下的數值
Set Rng = Ap.Workbooks(1).Sheets(1).Range("A1") '指名C檔下
Rng.EntireColumn = ""
Set Rng = Rng.Resize(UBound(AR))
Rng.Value = AR 'A檔下的數值貼在B檔上
AR = "" 'AR 清空
For Each E In Rng
'大於5 寫上D欄的值
If E > 5 Then AR = AR & "," & E.Range("d1")
Next
Set Rng = ThisWorkbook.Sheets(1).Range("C:C") '
Rng = ""
If AR <> "" Then
AR = Split(Mid(AR, 2), ",")
Rng(1).Resize(UBound(AR)) = Application.WorksheetFunction.Transpose(AR)
'B檔-->'大於5 寫上D欄的值 **寫在A檔C欄
End If
End Sub
Private Sub Ex_結束()
Ap.Workbooks(1).Close False
xApp.App.Visible = False
End Sub

複製代碼

作者: 502243 時間: 2019-3-13 20:46

回復 9# GBKEE

請教GBKEE大大:
剛看了幾個小時在一行一行測試..
有幾個地方不太明白
1.
For Each E In Rng
         '大於5 寫上D欄的值
         If E > 5 Then AR = AR & "," & E.Range("d1")    <===E.Range("d1")  為何是用E?而不是用Ap.Workbooks("c").Sheets(1)...這段看不大明白
      Next

      Set Rng = Ap.Workbooks("1").Sheets(1).Range("C:C") '
      Rng = ""
      If AR <> "" Then '有資料 <====AR最上面不是已經清空為0了??
         AR = Split(Mid(AR, 2), ",") '分割
         Rng(1).Resize(UBound(AR)) = Application.WorksheetFunction.Transpose(AR)
         'B檔-->'大於5 寫上D欄的值 **寫在A檔C欄
      End If

2.跑的時候C.xlsm檔案A欄有複製到值..但D欄還是一樣空空的...而且不會copy回A.xlsm ...C欄
3.另外請問GBKEE大大如果想關閉新開的excel.exe這個物件...當下應該用甚麼指令才行呢? xApp.App.Quit    ' Ap.Quit    ' Ap.Close <==這幾個我試好像都不行

作者: 502243 時間: 2019-3-13 21:00

回復 8# Scott090
感謝前輩的回應
類似那樣呼叫但又不大一樣.....差在跨層呼叫
第一條參考我試過.可行
第二條我會在試看看
[attach]30228[/attach]
目前朝Application物件那方面嘗試..也就是.GBKEE大大給的參考下去研究

作者: zheng211016 時間: 2019-3-13 22:58

回復 3# 502243

所以我的檔案有回答到你的問題?

作者: 502243 時間: 2019-3-14 08:28

回復 12# zheng211016
差在多一個excel.exe的物件控制..就麻煩了點...網路上探討的好像並不多
也或者是我的查詢時關鍵字沒查到..
不過還是感謝各位前輩的指點協助

作者: 502243 時間: 2019-3-14 08:34

假若拿Sub Ex_newexce1()出來修改一下..
只是單純的複製貼上

Sub Ex_newexce2()
   Dim AR As Variant, Rng(1 To 2) As Range, E As Range

   With Workbooks("a").Sheets(1)
      Set Rng(1) = .Range(“A1”, .Range(“A1”).End(xlDown)) ‘同excel.exe 可以成功
      Set Rng(2) = Workbooks(“a”).Sheets(1).Range(“c1”)    ‘A檔A欄copy A檔C欄
         Rng(1).Copy Rng(2)
   End With

End Sub

Sub Ex_newexce3()
   Dim AR As Variant, Rng(1 To 2) As Range, E As Range

   With Workbooks("a").Sheets(1)
      Set Rng(1) = .Range(“A1”, .Range(“A1”).End(xlDown)) ‘不同excel.exe  會失敗
      Set Rng(2) = Ap.Workbooks(“c”).Sheets(1).Range(“c1”) ‘‘A檔A欄copy C檔C欄
         Rng(1).Copy Rng(2)
   End With
[attach]30229[/attach]
End Sub

小弟還在思索著錯誤的原因....

作者: GBKEE 時間: 2019-3-14 09:13

本帖最後由 GBKEE 於 2019-3-14 10:20 編輯

回復 10# 502243
你只用圖片說明,但如再能加上範例檔祥加說明一切狀況,
回覆者會貼切的回答

你疑惑<===E.Range("d1")  為何是用E?而不是用Ap.Workbooks("c").Sheets(1)
A的資料不是要貼上C 的A欄嗎?
Set Rng = Ap.Workbooks(1).Sheets(1).Range("A1") '指名C檔下
篩選[A欄]>5 取的 C 的D欄的資料  >>不就  E.Range("d1")

你疑惑  If AR <> "" Then '有資料 <====AR最上面不是已經清空為0了??
這裡啊******
For Each E In Rng
      '大於5 寫上D欄的值  **有
      If E > 5 Then AR = AR & "," & E.Range("d1")
Next
***********
xApp.App.Quit 或 Ap.Quit    都可

回復 14# 502243
不同excel.exe  間的物件無法用Copy

作者: 502243 時間: 2019-3-14 16:23

回復 15# GBKEE

感謝GBKEE版主大大的幫助..
目前按照版大的樣本大略修改了一下..如下附檔[attach]30232[/attach]
另外會朝不同excel.exe  間的物件控制關鍵字在下去搜尋相關語句
   Ap.Quit <==這指令用在excel.exe物件裡面可以讓表面程式看起來不見  卻會殘存excel.exe
導致如果強制從  工作管理員關閉的話  再次啟動  Sub Ex_開始( )會產生"462"錯誤 <==錯誤發生的原因很多

[attach]30230[/attach][attach]30231[/attach]
不過給的方向還是幫助很大....很感謝.....(畢竟小弟研究了一個禮拜都找不到方向..心理滴咕著)

作者: quickfixer 時間: 2019-3-15 04:15

本帖最後由 quickfixer 於 2019-3-15 04:18 編輯

回復 16# 502243

你要的不是同一個excel開2個檔互傳,而是2個不同excel.exe互傳資料,對嗎?

參考資料來源
https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=1
(#244f)
我試過工作管理員不會殘存excel.exe
1.xlsm

Sub test()
Dim app1 As Object, book1 As Excel.Workbook
Set app1 = CreateObject("Excel.Application")
Set book1 = app1.Workbooks.Open(ThisWorkbook.Path & "\" & "2.xlsm")
app1.Visible = True
Dim sourcedata As Range, targetdata As Range, temp() As Variant
Set sourcedata = Sheets("a").Range("a1:a5")
Set targetdata = book1.Sheets("b").Range("a1:a5")
temp = sourcedata
targetdata.Value = temp
app1.Run "test"
Set sourcedata = book1.Sheets("b").Range("b1:b5")
Set targetdata = Sheets("a").Range("c1:c5")
temp = sourcedata
targetdata.Value = temp
book1.Close SaveChanges:=False
app1.Quit
Set app1 = Nothing
Set book1 = Nothing
End Sub

複製代碼

2.xlsm

Sub test()
For i = 1 To 5
Sheets("b").Cells(i, 2) = Sheets("b").Cells(i, 1) + Rnd()
Next i
End Sub

複製代碼

[attach]30233[/attach]

作者: GBKEE 時間: 2019-3-15 07:45

回復 16# 502243
'一般 Module 的程式碼

Option Explicit
Public Ap As Object, Aa As Object
Sub Ex_開始()
'新開2個Excel 程式
Set Ap = New Application
Set Aa = New Application
Stop '開啟工作管理員看看
Ap.Visible = True
Stop '開啟工作管理員看看
Aa.Visible = True
Stop '開啟工作管理員看看
End Sub
Sub Ex_結束()
Stop '開啟工作管理員看看
Ap.Quit
Stop '開啟工作管理員看看
Aa.Quit
Stop '開啟工作管理員看看
End Sub

複製代碼

作者: 502243 時間: 2019-3-15 08:17

回復 17# quickfixer

感謝quickfixer大大的資料參考
的確是兩個不同的excel.exe資料互傳....
原來是要利用set 加上緩衝區...
屆時我會參考前輩們的模型基板下去做修改調整.....
萬分感謝~

作者: 502243 時間: 2019-3-15 08:41

本帖最後由 502243 於 2019-3-15 08:43 編輯

回復 18# GBKEE

'一般 Module 的程式碼
Option Explicit
Public Ap As Object, Aa As Object
Sub Ex_開始( )
'新開2個Excel 程式
Set Ap = New Application
Set Aa = New Application
Stop '開啟工作管理員看看
Ap.Visible = True
Stop '開啟工作管理員看看
Aa.Visible = True
' Stop '開啟工作管理員看看
End Sub
Sub Ex_結束( )
Stop '開啟工作管理員看看
Ap.Quit
Stop '開啟工作管理員看看
Aa.Qui
Stop '開啟工作管理員看看
End Sub
Sub test( )
Dim app1 As Object, book1 As Excel.Workbook
Set app1 = CreateObject("Excel.Application")
app1.Visible = True
app1.Quit
Set app1 = Nothing
End Sub

複製代碼

剛試了一下 test可以完全關閉新建立excel.exe 與上面的差異多了一個set app1=Nothing
所以新建excel物件建立與關閉不能拆分成兩個副程式?
恩...我在多試幾個看看

作者: Scott090 時間: 2019-3-15 08:59

回復 17# quickfixer

謝謝點明了 application.run --> app1.Run "test"

作者: quickfixer 時間: 2019-3-15 19:28

回復 20# 502243

dim 改 public,像 gbkee #16 那像寫,就可以把關閉放到另一個sub
Public app1 As Object, book1 As Excel.Workbook

作者: adrian_9832 時間: 2019-3-18 22:22

Sub readData()

'数据读取
'----------------------------------------------
    Dim dataExcel, Workbook, sheet
    Dim totalRow As Integer
    Set dataExcel = CreateObject("Excel.Application")
    Set Workbook = dataExcel.Workbooks.Open("E:\要读取数据的源文件.xlsx")
    Set sheet = Workbook.Worksheets(1) '读取第一个sheet页的数据
    totalRow = sheet.UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    For i = 2 To totalRow

         Sheets("sheet1").Cells(i, 3) = sheet.Cells(i, 4)

    Next i
    Workbook.Close
    MsgBox "读取成功！", vbSystemModal '读取完后弹框提醒
'----------------------------------------------
End Sub

作者: 502243 時間: 2019-3-19 10:50

回復 22# quickfixer

感謝quickfixer大..一語驚醒夢中人..
還在想說怎麼拆分...
現在已經順利將建成物件..和A檔copy到C檔..C檔copy回A檔 ..分成3個副程式框架
剩下再把其餘的副程式加入其中...
調整一些流程步驟..

感謝回應這篇主題的各位前輩點醒...

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)