eg0802

中學生 Rank: 2

帖子: 81
主題: 26
精華: 0
積分: 106
點名: 0
作業系統: WIN7
軟體版本: 32位元
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2012-3-3
最後登錄: 2019-6-26

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

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

[發問] 指定儲存格update 到orderlist

本帖最後由 eg0802 於 2013-5-14 15:18 編輯

HELP.rar (92.99 KB) 各位版神......小弟最近遇到難題懇請大大幫忙!!
需求如下 JZT-BC 總表裡面包含很多工作表我需要把上色的部分(ETD / ETA / 總件數 / 總金額) update 至 orderlist. 小弟對VBA不是很懂，懇求大大幫忙!!! Orz.....

樓主熱帖

Jason

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兔年全勤獎章

2^#

發表於 2013-5-14 17:56 | 只看該作者

回復 1# eg0802
試試看

Option Explicit
Sub Ex()
Dim Sh As Worksheet, AR(1 To 2), Rng As Range, R As Integer, i As Integer
AR(1) = Array("H", "I", "L", "M") 'summary-2014 中的欄位
For Each Sh In Workbooks("JZT BC-總表.xlsx").Sheets 'JZT BC-總表.xlsx活頁簿 Sheets(物件集合)
With Sh
With .[A:A].Find("Total", LOOKAT:=xlWhole) '尋找A欄中的"Total"
.Cells(1, "B").Name = "QTY" '位於B欄的存存格命名
.Cells(1, "I").Name = "TotalPrice" '位於I欄的存存格命名
End With
AR(2) = Array(.[QTY], .[TotalPrice], .[B24], .[C25])
With Workbooks("Order List 2014_0502.xls").Sheets("'summary-2014")
R = .Cells(.Rows.Count, "H").End(xlUp).Offset(1).Row 'H欄:檔案底部往上有資料下一列的列號
'*** Order List 2014_0502.xls H欄中 10:65536 間還有資料請清除 ***
For i = 0 To 3
.Range(AR(1)(i) & R) = AR(2)(i)
Next
End With
End With
Next
End Sub

複製代碼

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

TOP

eg0802

中學生 Rank: 2

帖子: 81
主題: 26
精華: 0
積分: 106
點名: 0
作業系統: WIN7
軟體版本: 32位元
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2012-3-3
最後登錄: 2019-6-26

3^#

發表於 2013-5-14 22:53 | 只看該作者

回復 2# GBKEE

G大...不行耶....不知道是不是小弟用不對我有上傳圖片請大大幫忙看一下~~感恩
[attach]14982[/attach]

Jason

TOP

eg0802

中學生 Rank: 2

帖子: 81
主題: 26
精華: 0
積分: 106
點名: 0
作業系統: WIN7
軟體版本: 32位元
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2012-3-3
最後登錄: 2019-6-26

4^#

發表於 2013-5-14 23:04 | 只看該作者

回復 2# GBKEE

抱歉G大  不知為何圖上傳不了....跑了您寫的出現以下錯誤信息

      執行階段錯誤'9
      陣列索引超出範圍

Jason

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

5^#

發表於 2013-5-14 23:36 | 只看該作者

回復 4# eg0802
Order List 2014_0502的A欄編號不知有何意義?
兩個檔案放在同一個資料夾目錄中
JZT BC-總表活頁簿由程式碼開啟，不要事先開啟
執行
Order List 2014_0502活頁簿內模組程式碼

Sub Update_Data()
Dim Ar()
fs = ThisWorkbook.Path & "\JZT BC-總表.xlsx"
With Workbooks.Open(fs)
For Each sh In .Sheets
With sh
a = .Columns("A").Find("Total", lookat:=xlWhole).Offset(, 1).Value
b = .Columns("H").Find("Total amount", lookat:=xlWhole).Offset(, 1).Value
c = .Columns("A").Find("DELIVERY: ", lookat:=xlWhole).Offset(, 1).Value
d = .Columns("A").Find("IN WAREHOUSE DATE: ", lookat:=xlWhole).Offset(, 2).Value
ReDim Preserve Ar(s)
Ar(s) = Array(CStr(.Name), "", "", a, b, "", "", c, d)
s = s + 1
End With
Next
.Close 0
End With
If s > 0 Then ThisWorkbook.Sheets("summary-2014").[E10].Resize(s, 9) = Application.Transpose(Application.Transpose(Ar))
End Sub