麻辣家族討論版版 » Excel程式區 » 如何使用陣列到不同sheet抓取資料

返回列表下一主題上一主題發帖

如何使用陣列到不同sheet抓取資料

中學生 Rank: 2

帖子: 45
主題: 19
精華: 0
積分: 84
點名: 0
作業系統: Windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-9
最後登錄: 2015-4-14

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2013-12-4 11:56 | 只看該作者

如何使用陣列到不同sheet抓取資料

各位大大,
請問該如何使用陣列到不同sheet抓取資料
檔案如附件

更新1.rar (27.39 KB)

樓主熱帖

收藏

中學生 Rank: 2

帖子: 45
主題: 19
精華: 0
積分: 84
點名: 0
作業系統: Windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-9
最後登錄: 2015-4-14

7^#

發表於 2013-12-24 17:20 | 只看該作者

回復 5# ML089

了解,謝謝告知

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 44
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-2-20

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2013-12-6 08:45 | 只看該作者

回復 1# yueh0720

Private Sub Update_Click()
Dim y&, xR As Range, uP$, uF$, Ar(), Sh As Worksheet
uP = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
With Sheet1
For Each xR In .Range(.[A2], .[A65536].End(3)).SpecialCells(xlCellTypeConstants)
If Dir(uP & xR) = "" Then GoTo 101
With Workbooks.Open(uP & xR)
For Each Sh In .Sheets
With Sh
ReDim Preserve Ar(s)
Ar(s) = Array(.[C5].Value, .[D10].Value, .[J21].Value, .[J26].Value)
s = s + 1
End With
Next
.Close 0
End With
xR.Offset(, 1).Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
Erase Ar: s = 0
101: Next
End With
End Sub

複製代碼

學海無涯_不恥下問

版主 Rank: 7 Rank: 7 Rank: 7

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

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

5^#

發表於 2013-12-5 21:09 | 只看該作者

回復 3# yueh0720

如果你對那層樓有意見時，請按該層樓下方的回覆，這樣系統才會通知。

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

版主 Rank: 7 Rank: 7 Rank: 7

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

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

4^#

發表於 2013-12-5 21:06 | 只看該作者

回復 3# yueh0720

Private Sub Update_Click()
Dim y&, xR As Range, uP$, uF$
xRange = Array("Sheet1'!C5", "Sheet1'!D10", "Sheet1'!J21", "Sheet1'!J26", _
"第三頁'!C5", "第三頁'!D10", "第三頁'!J21", "第三頁'!J26", _
"第七頁'!C5", "第七頁'!D10", "第七頁'!J21", "第七頁'!J26")
uP = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
For Each xR In Range([A2], [A65536].End(3))
If Dir(uP & xR) = "" Then GoTo 101
uF = "'" & uP & "[" & xR & "]"
j = 2
For Each xC In xRange
xR(1, j) = "=" & uF & xC
j = j + 1
Next
101:
Next
End Sub

複製代碼

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

中學生 Rank: 2

帖子: 45
主題: 19
精華: 0
積分: 84
點名: 0
作業系統: Windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-8-9
最後登錄: 2015-4-14

3^#

發表於 2013-12-5 15:14 | 只看該作者

ML089 大,
沒辦法~分頁無法複製

版主 Rank: 7 Rank: 7 Rank: 7

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

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

2^#

發表於 2013-12-4 17:52 | 只看該作者

回復 1# yueh0720
是這樣嗎?

Private Sub Update_Click()
Dim y&, xR As Range, uP$, uF$
xRange = Array("$C$5", "$D$10", "$J$21", "$J$26")
uP = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
For Each xR In Range([A2], [A65536].End(3))
If Dir(uP & xR) = "" Then GoTo 101
uF = "'" & uP & "[" & xR & "]Sheet1'!"
j = 2
For Each xC In xRange
xR(1, j) = "=" & uF & xC
j = j + 1
Next
101:
Next
End Sub

複製代碼

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

靜思自在 : 脾氣嘴巴不好，心地再好也不能算是好人。

返回列表下一主題上一主題