123
返回列表 上一主題 發帖

[發問] 將資料寫入到其他多個EXCEL檔案

mark761222

帖子
57 
主題
21 
精華
0 
積分
83 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2022-9-13 
1# 跳轉到 »
發表於 2015-11-4 14:25 | 只看該作者

兩個xls的工作表資料同步

問題一
假如我有A.xlsx  與B.xlsm (巨集檔)
A.xlsx 有工作表1

B.xlsm 有工作表1，要去抓取所有A的所有工作表1內容到B工作表1 (只要A.xlsx資料有更新B就會更新資料)

問題二

假如我有A.xlsx  與B.xlsm (巨集檔)
A.xlsx 有工作表1

B.xlsm 有工作表1，要去抓取所有A工作表1裡面整合內容如 B整行、D整行、E整行 到B工作表1的 A整行、B整行、C整行 (只要A.xlsx資料有更新B就會更新資料)

麻煩各位大大了

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 2015-11-4 15:27 | 只看該作者
本帖最後由 lpk187 於 2015-11-4 15:30 編輯

回復 1# mark761222

首先必須說明，兩個xls的工作表資料不可能同步！！就算同時更新時，也不能稱為同步！就算程式碼寫在a檔案，也一樣，都會有例外的時候，所以只能以程式來讀取a檔案的最新資料而已，下面程式碼也只是讀取最新資料，而不能稱之為"同步"
其2個問題程式碼如下：
  1. Public Sub ex1()
  2.     Sheets("工作表1").UsedRange.ClearContents
  3.     Dim xlPath As Variant, xlFile As Variant
  4.     Dim arr
  5.     xlPath = ThisWorkbook.Path & "\"
  6.     xlFile = "a.xlsx"
  7.     Workbooks.Open (xlPath & xlFile)
  8.     arr = Workbooks(xlFile).Worksheets("工作表1").UsedRange
  9.     Workbooks(xlFile).Close True
  10.     Sheets("工作表1").[A1].Resize(UBound(arr), UBound(arr, 2)) = arr
  11. End Sub
  12. Public Sub ex2()
  13.     Sheets("工作表1").UsedRange.ClearContents
  14.     Dim xlPath As Variant, xlFile As Variant
  15.     Dim Barr, Darr, Earr
  16.     xlPath = ThisWorkbook.Path & "\"
  17.     xlFile = "a.xlsx"
  18.     Workbooks.Open (xlPath & xlFile)
  19.     With Workbooks(xlFile).Worksheets("工作表1")
  20.         Barr = .Range("B1", .Cells(65535, "B").End(xlUp))
  21.         Darr = .Range("D1", .Cells(65535, "D").End(xlUp))
  22.         Earr = .Range("E1", .Cells(65535, "E").End(xlUp))
  23.     End With
  24.     Workbooks(xlFile).Close True
  25.     With Sheets("工作表1")
  26.         .[A1].Resize(UBound(Barr)) = Barr
  27.         .[B1].Resize(UBound(Darr)) = Darr
  28.         .[C1].Resize(UBound(Earr)) = Earr
  29.     End With
  30. End Sub
複製代碼

TOP

mark761222

帖子
57 
主題
21 
精華
0 
積分
83 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2022-9-13 
3#
發表於 2015-11-5 01:33 | 只看該作者
感謝lpk187!
正在努力理解你寫的程式架構

TOP

mark761222

帖子
57 
主題
21 
精華
0 
積分
83 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2022-9-13 
4# 倒序看帖
打印
tT
發表於 2015-11-5 02:39 | 只看該作者

[發問] 將資料寫入到其他多個EXCEL檔案


我有三個EXCEL檔案分別為A B C 如圖
A為計算檔案透過按鈕將資料傳送到B 與 C
判斷B 與 C資料最後一筆資料並填上

有大哥大姐寫過類式的程式嗎
收藏 分享

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
5#
發表於 2015-11-5 06:25 | 只看該作者
回復 1# mark761222

請參考
http://minyeh187.pixnet.net/blog/post/166816531

TOP

mark761222

帖子
57 
主題
21 
精華
0 
積分
83 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2022-9-13 
6#
發表於 2015-11-5 13:42 | 只看該作者
TO lpk187
又遇到問題了，稍微改了一下程式
假設A 工作表有2筆資料 A1:E1 要送資料到B
A2:E2要送資料C
改了以下程式，但是只傳送日期，內容不會傳送，而且日期還重複2次，是哪裡理解錯誤了嗎

不好意思一值麻煩你
  1. Private Sub Workbook_Open()
  2. Dim xlPath As Variant, Ro As Integer
  3. Dim xlFilea, xlFileb, arra, arrb
  4.     xlPath = ThisWorkbook.Path & "\"
  5. xlFilea = ("B.xlsx")
  6. xlFileb = ("C.xlsx")
  7. arra = Sheets("工作表1").Range("A1:E1")
  8. arrb = Sheets("工作表1").Range("A2:E2")

  10. For i = 0 To 1
  11.     Workbooks.Open (xlPath & xlFilea)
  12.     With Workbooks(xlFilea).Worksheets("工作表1")
  13.          Ro = .Cells(65535, 1).End(xlUp).Row + 1
  14.         .Cells(Ro, 1) = arra
  15.     End With
  16.     Workbooks(xlFilea).Close True
  17. Next
  18. For i = 0 To 1
  19.     Workbooks.Open (xlPath & xlFileb)
  20.     With Workbooks(xlFileb).Worksheets("工作表1")
  21.          Ro = .Cells(65535, 1).End(xlUp).Row + 1
  22.          .Cells(Ro, 1) = arrb
  23.     End With
  24.     Workbooks(xlFileb).Close True
  25. Next

  27. End Sub
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
7#
發表於 2015-11-6 09:31 | 只看該作者
回復 6# mark761222


   日期還重複2次是你多寫了 For i = 0 To 1 ，把2個For i = 0 To 1...Next刪了吧！
致於為什麼只傳送日期，內容不會傳送
則是.Cells(Ro, 1) = arra 錯誤，你應該要多加Resize範圍給它
.Cells(Ro, 1).Resize(Ubound(arra),Ubound(arra,2)) = arra
.Cells(Ro, 1) = arrb 亦同上

TOP

mark761222

帖子
57 
主題
21 
精華
0 
積分
83 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2022-9-13 
8#
發表於 2015-11-6 12:54 | 只看該作者
回復 7# lpk187

謝謝!真的可以了，如果要加上驗證機制應該很難吧
例如A 2015/11/6去偵測B 2015/11/6 與C 2015/11/6  如果有這個日期不新增，有的話新增

謝謝你的指導!

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 2015-11-6 13:51 | 只看該作者
回復 8# mark761222

試試看
  1. Private Sub Workbook_Open()
  2. Dim xlPath As Variant, Ro As Integer
  3. Dim xlFilea, xlFileb, arra, arrb
  4.     xlPath = ThisWorkbook.Path & "\"
  5. xlFilea = ("B.xlsx")
  6. xlFileb = ("C.xlsx")
  7. arra = Sheets("工作表1").Range("A1:E1")
  8. arrb = Sheets("工作表1").Range("A2:E2")
  9.     Workbooks.Open (xlPath & xlFilea)
  10.     With Workbooks(xlFilea).Worksheets("工作表1")
  11.         Set da = .Columns(1).Find(arra(1, 1), , , , , 2)
  12.         If Not da Is Nothing Then GoTo 10
  13.          Ro = .Cells(65535, 1).End(xlUp).Row + 1
  14.          
  15.         .Cells(Ro, 1) = arra
  16.     End With
  17. 10:
  18.     Workbooks(xlFilea).Close True

  20.     Workbooks.Open (xlPath & xlFileb)
  21.     With Workbooks(xlFileb).Worksheets("工作表1")
  22.         Set da = .Columns(1).Find(arra(1, 1), , , , , 2)
  23.         If Not da Is Nothing Then GoTo 10
  24.         Ro = .Cells(65535, 1).End(xlUp).Row + 1
  25.         .Cells(Ro, 1) = arrb
  26.     End With
  27. 20:
  28.     Workbooks(xlFileb).Close True

  30. End Sub
複製代碼

TOP

mark761222

帖子
57 
主題
21 
精華
0 
積分
83 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2022-9-13 
10#
發表於 2015-11-7 01:56 | 只看該作者
夭壽!越來越複雜，都快看不懂了= =
可以幫忙註解一下嗎@@

TOP

        靜思自在 : 脾氣嘴巴不好，心地再好也不能算是好人。
123
返回列表 上一主題