12
返回列表 上一主題 發帖

如何經由VB的按鈕 由一個EXCEL檔案資料匯入至另一EXCEL

g93353

帖子
40 
主題
17 
精華
0 
積分
62 
點名
0  
作業系統
windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-27 
最後登錄
2014-11-18 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-12-27 13:56 | 只看該作者

如何經由VB的按鈕 由一個EXCEL檔案資料匯入至另一EXCEL

想請問一下高手們


今天在EXCEL1.xls  新增了一個COMMAND

點擊後確認入徑後(  為另一個xls檔 :EX:  EXCEL2.xls )

就能將EXCEL2.xls裡的表格資料貼至EXCEL1.xls

想請問一下 VB的巨集要怎麼寫會比較好  

麻煩各位高手解答了>"<
收藏 分享
WOW

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
15#
發表於 2016-9-22 11:46 | 只看該作者
這是我測試的code但有錯誤
  1. Private Sub 測試()
  2. Dim Source As String, Ar()
  3.       Source = application.run(Activeworkbook.Name&"!測試")
  4.       With Workbooks.Open(Source)
  5.         Ar = .Sheets(1).Range("A1:D65536").value
  6.         .Close
  7.     End With
  8.     With ThisWorkbook.Sheets("測試").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
  9.         .value = Ar
  10.         .Name = "測試"
  11.      End With

  13.     MsgBox "測試資料匯入成功"
  14. End Sub
複製代碼
或是可否使用在資料表上設定一個儲存格的名稱為test
然後應用這個名稱 可以把檔案匯入進來

TOP

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
14#
發表於 2016-9-22 11:37 | 只看該作者
回復 13# white5168
謝謝你的建議，已修正回來
回復 11# GBKEE
又有個疑問

若不要使用vb按鈕

直接應用檔案名字(在同個資料夾下)

就可以把資料匯入

這該怎麼修改呢?

ex:檔案名稱為==>測試.xlsx

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
13#
發表於 2016-9-10 16:54 | 只看該作者
不建議使用UsedRange，如果遇到有空一大段的儲存格，那資料就無法完整匯出

TOP

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
12#
發表於 2016-9-9 15:16 | 只看該作者
回復 11# GBKEE


感謝G大的大力相助
我昨天有試過你之前貼的程式碼
  1. Private Sub Data_Click()
  2. Dim Source As String, Ar()
  3.     Source = Application.GetOpenFilename
  4.     With Workbooks.Open(Source)
  5.         Ar = .Sheets(1).Range("A1:BN65536").Value
  6.         .Close
  7.     End With
  8.     With ThisWorkbook.Sheets("data").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
  9.         .Value = Ar
  10.         .Name = "data"
  11.      End With
  12.     End Sub
複製代碼
中間我直接讀取之前檔案全部儲存格內容
現在改成
  1. Private Sub Data_Click()
  2. Dim Source As String, Ar()
  3.     Source = Application.GetOpenFilename
  4.      With Workbooks.Open(Source)
  5.         Ar = .Sheets(1).UsedRange.Value
  6.         .Close
  7.     End With
  8.     With ThisWorkbook.Sheets("data").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
  9.         .Value = Ar
  10.         .Name = "data"
  11.      End With
  12. End Sub
複製代碼
從Range("A1:BN65536")改為UsedRange
這個方法快多了
有成功執行 真的很感謝你!!!!!

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11#
發表於 2016-9-9 14:02 | 只看該作者
回復 10# Changbanana
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Source As String, Ar()
  4.     Source = Application.GetOpenFilename
  5.     With Workbooks.Open(Source)
  6.         Ar = .Sheets(1).UsedRange.Value
  7.         .Close
  8.     End With
  9.     With ThisWorkbook.Sheets("data").Range("A1").Resize(UBound(Ar), UBound(Ar, 2))
  10.         .Value = Ar
  11.         .Name = "Data"
  12.         .Select
  13.     End With
  14. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
10#
發表於 2016-9-7 17:07 | 只看該作者
回復 7# GBKEE [/

剛之前在六樓回錯了
應該是要回覆二樓的程式
我表達的沒有很清楚抱歉

我的意思是(問題):

已在EXCEL1.xls  新增了一個COMMAND

點擊後確認入徑後(  為另一個xls檔 :EX:  EXCEL2.xls )

就能將EXCEL2.xls裡的全部資料(只有一個工作表資料範圍沒限制)貼至工作表名稱固定為'data'的EXCEL1.xls

------------------------------------------------
測試完二樓的程式後

EXCEL2.xls裡的全部資料是全部貼至EXCEL1.xls了

但是連工作表的名稱也貼過去了

因EXCEL2.xls 的工作表的名稱是會隨著儲存日期而改變
而EXCEL1.xls裡的工作表有額外做巨集
下列是有關在EXCEL1.xls裡寫到的程式碼
  1. Sheets("工作表1").Select
  2. Arr = Range([data!A2], [data!A65536].End(xlUp)(1, 65))
複製代碼
因為這樣故需要指定工作表的名稱
這樣巨集才可使用

TOP

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
9#
發表於 2016-9-7 15:17 | 只看該作者
[版主管理留言]
  • GBKEE(2016/9/7 15:23): Ar = .Sheets(1).Range("A1:C10").Value

回復 7# GBKEE
  1. Sub XX()
  2.     Dim Source As String, Ar()
  3.     Source = Application.GetOpenFilename
  4.     With Workbooks.Open(Source)
  5.           Ar = .Sheets(1).Value
  6.          .Close
  7.     End With
  8.     With ThisWorkbook.Sheets(1)
  9.         .Value = Ar
  10.         .Name = "Data"
  11.         .Select
  12.     End With
  13. End Sub
複製代碼
在Ar = .Sheets(1).Value 出了問題

TOP

Changbanana

帖子
76 
主題
17 
精華
0 
積分
95 
點名
0  
作業系統
windowsxp 
軟體版本
office2007 
閱讀權限
20 
性別
女 
註冊時間
2016-8-19 
最後登錄
2021-5-5 

論壇贊助勳章
8#
發表於 2016-9-7 15:08 | 只看該作者
回復 7# GBKEE


感謝高手的答覆~

若資料沒有限定範圍~是整個工作表複製呢

那這樣該怎麼改


謝謝您~
(目前正在學習vba中所以有好多問題@@

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2016-9-7 15:01 | 只看該作者
回復 6# Changbanana
試試看
  1. Option Explicit
  2. Sub XX()
  3.     Dim Source As String, Ar()
  4.     Source = Application.GetOpenFilename
  5.     With Workbooks.Open(Source)
  6.         Ar = .Sheets(1).Range("A1:C10").Value
  7.         .Close
  8.     End With
  9.     With ThisWorkbook.Sheets(1).Range("D2").Resize(UBound(Ar), UBound(Ar, 2))
  10.         .Value = Ar
  11.         .Name = "Data"
  12.         .Select
  13.     End With
  14. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
12
返回列表 上一主題