將資料寫入到其他多個EXCEL檔案 - Excel程式區

帖子: 57
主題: 21
精華: 0
積分: 83
點名: 0
作業系統: win7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2015-9-18
最後登錄: 2022-9-13

13^#

發表於 2015-11-7 16:33 | 只看該作者

回復 12# lpk187

好!我全部整理一下再跟你說，謝謝

lpk187

高中生 Rank: 3 Rank: 3

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

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

12^#

發表於 2015-11-7 08:22 | 只看該作者

回復 11# mark761222

可以的話，請附上你的範例檔案上來，而且是你最終目的的範例檔，目的不同，就算只有些許的改變，可能程式都要大幅的改變，就像11樓的問題，和之前的寫法大部份會不一樣！
甚至可以的話在範例檔中請附上C欄及F欄的公式！

帖子: 57
主題: 21
精華: 0
積分: 83
點名: 0
作業系統: win7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2015-9-18
最後登錄: 2022-9-13

11^#

發表於 2015-11-7 02:33 | 只看該作者

回復 9# lpk187
我試過了!可以但有一個地方會錯誤，第一次資料轉出可以，再按第二次他會出現下圖

Sub Workbook_Open2()
Dim xlPath As Variant, Ro As Integer
Dim xlFilea, xlFileb, arra, arrb
xlPath = ThisWorkbook.Path & "\"
xlFilea = ("B.xlsx")
xlFileb = ("C.xlsx")
arra = Sheets("工作表1").Range("A1:F1")
arrb = Sheets("工作表1").Range("A2:F2")
Workbooks.Open (xlPath & xlFilea)
With Workbooks(xlFilea).Worksheets("工作表1")
Set da = .Columns(1).Find(arra(1, 1), , , , , 2)
If Not da Is Nothing Then GoTo 10
Ro = .Cells(65535, 1).End(xlUp).Row + 1
.Cells(Ro, 1).Resize(UBound(arra), UBound(arra, 2)) = arra
End With
10:
Workbooks(xlFilea).Close True
Workbooks.Open (xlPath & xlFileb)
With Workbooks(xlFileb).Worksheets("工作表1")
Set da = .Columns(1).Find(arrb(1, 1), , , , , 2)
If Not da Is Nothing Then GoTo 10
Ro = .Cells(65535, 1).End(xlUp).Row + 1
.Cells(Ro, 1).Resize(UBound(arrb), UBound(arrb, 2)) = arrb
End With
20:
Workbooks(xlFileb).Close True
End Sub

複製代碼

另一方面如果傳送方式變成如下圖
c.xlsx會有函數去計算數值，可以跳格傳送嗎

帖子: 57
主題: 21
精華: 0
積分: 83
點名: 0
作業系統: win7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2015-9-18
最後登錄: 2022-9-13

10^#

發表於 2015-11-7 01:56 | 只看該作者

夭壽!越來越複雜，都快看不懂了= =
可以幫忙註解一下嗎@@

lpk187

高中生 Rank: 3 Rank: 3

帖子: 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

試試看

Private Sub Workbook_Open()
Dim xlPath As Variant, Ro As Integer
Dim xlFilea, xlFileb, arra, arrb
xlPath = ThisWorkbook.Path & "\"
xlFilea = ("B.xlsx")
xlFileb = ("C.xlsx")
arra = Sheets("工作表1").Range("A1:E1")
arrb = Sheets("工作表1").Range("A2:E2")
Workbooks.Open (xlPath & xlFilea)
With Workbooks(xlFilea).Worksheets("工作表1")
Set da = .Columns(1).Find(arra(1, 1), , , , , 2)
If Not da Is Nothing Then GoTo 10
Ro = .Cells(65535, 1).End(xlUp).Row + 1
.Cells(Ro, 1) = arra
End With
10:
Workbooks(xlFilea).Close True
Workbooks.Open (xlPath & xlFileb)
With Workbooks(xlFileb).Worksheets("工作表1")
Set da = .Columns(1).Find(arra(1, 1), , , , , 2)
If Not da Is Nothing Then GoTo 10
Ro = .Cells(65535, 1).End(xlUp).Row + 1
.Cells(Ro, 1) = arrb
End With
20:
Workbooks(xlFileb).Close True
End Sub

複製代碼

帖子: 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 如果有這個日期不新增，有的話新增

謝謝你的指導!

lpk187

高中生 Rank: 3 Rank: 3

帖子: 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 亦同上