可以請教當欄位不是固定在一個位置我要如何copy到第2活頁

帖子: 29
主題: 5
精華: 0
積分: 82
點名: 0
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 20
註冊時間: 2012-6-14
最後登錄: 2020-9-14

12^#

發表於 2013-11-28 18:49 | 只看該作者

回復 10# GBKEE

謝謝大大,解開我的疑慮,感謝大大的幫忙

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

13^#

發表於 2013-11-29 08:59 | 只看該作者

回復 11# ML089

Option Base 1
Sub Ex()
Dim AR(), i As Integer, A As Range
AR = Array("工令", "品名", "MRP料齊日")
With Sheet1
For i = 1 To UBound(AR)
Set A = .Cells.Find(AR(i), lookat:=xlWhole)
If Not A Is Nothing Then .Range(A, A.End(xlDown)).Copy Sheet3.Cells(1, i)
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

版主 Rank: 7 Rank: 7 Rank: 7

ML089

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

14^#

發表於 2013-11-29 09:38 | 只看該作者

回復 13# GBKEE

GBKEE大讚，感謝指教，又學一招

AR = Array("工令", "品名", "MRP料齊日") 將要找的放在陣列中，將能程式碼構架化後就能彈性查詢。

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 29
主題: 5
精華: 0
積分: 82
點名: 0
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 20
註冊時間: 2012-6-14
最後登錄: 2020-9-14

15^#

發表於 2013-12-1 00:55 | 只看該作者

本帖最後由 GBKEE 於 2013-12-1 16:16 編輯

Book1.rar (21.77 KB)

Book2.rar (7.86 KB) 回復 13# GBKEE

謝謝大大的教導,但我假設我的檔案book1,xls 在c:\ 我一樣要copy"工令" "品名" "MRP料齊日" 到桌面上的BOOK2.XLS ,但我修改過粉多方式還會出現下面的問題,報歉我又要麻煩大大们

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

16^#

發表於 2013-12-1 16:33 | 只看該作者

本帖最後由 GBKEE 於 2013-12-1 16:35 編輯

回復 15# hu0318s

Option Base 1
Sub Ex()
Dim AR(), i As Integer, A As Range
AR = Array("工令", "品名", "MRP料齊日")
With Workbooks.Open(Filename:="C:\book1.xls") '檢查看看 C:有book1.xls嗎?
For i = 1 To UBound(AR)
Set A = .Worksheets("sheet1").Cells.Find(AR(i), lookat:=xlWhole)
If Not A Is Nothing Then .Worksheets("sheet1").Range(A, A.End(xlDown)).Copy Workbooks("book2.xls").Worksheets("Sheet3").Cells(1, i)
'如這程式碼是Workbooks("book2.xls")專案的程式碼
'If Not A Is Nothing Then .Worksheets("sheet1").Range(A, A.End(xlDown)).Copy Sheet3.Cells(1, i)
'Sheet3 是工作表物件的名稱無法用Workbooks("book2.xls").Sheet3
'需是Workbooks("book2.xls").Worksheets("工作表名稱")
Next
.Close False
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

帖子: 29
主題: 5
精華: 0
積分: 82
點名: 0
作業系統: XP
軟體版本: OFFICE2003
閱讀權限: 20
註冊時間: 2012-6-14
最後登錄: 2020-9-14

17^#

發表於 2013-12-1 19:07 | 只看該作者

回復 16# GBKEE

謝謝大大的幫忙,原來我一直想說用activesworkbook方式,去取的我要的訊息,謝謝大大的教導讓我學習更多新vba 寫法謝謝你