sax868

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2012-5-4 11:57 | 只看該作者

[發問] 請問如何分別撰寫VBA，使特定工作表的特定值合併，再抓特定值回原始檔

本帖最後由 sax868 於 2012-5-10 16:49 編輯

Notes adding.zip (221.94 KB)

各位高手大大好:

請問以下要如何分別撰寫VBA? 因為工作表一共有一百多個，天天手動改再整理資料快哭了...拜託~救我!!!

1)
在這個檔案裡建立一個新的工作表稱”Updated Data”且資料全是"值"就好，可以不要包含原來該欄位可能有的函數嗎?
A欄值是每張工作表的 C1 (除了兩張工作表以外,其名稱為 “DATA” 及”Currency”), 且A1的值是第一張工作表的B1
B欄值是每張工作表的 C2 (除了兩張工作表以外,其名稱為 “DATA” 及”Currency”), 且B1的值是第一張工作表的B2
C欄值是每張工作表的 E1 (除了兩張工作表以外,其名稱為 “DATA” 及”Currency”), 且C1的值是第一張工作表的D1
D1到BE1的值是第一張工作表的A11到BB11
D2到BE2 以下到底部的值是每一張worksheet裡的 A12到BB12到底部 (除了兩張工作表以外,其名稱為 “DATA” 及”Currency”)

2)
該張工作表AI12到底部的值是假設 $A12、$J12 及”固定$C$1” 三者的值與 ”Updated Data” 工作表裡A欄 D欄 M欄三者皆相符時則值為Updated Data工作表裡的AK欄
(我有用函數寫IF(AND+AND+AND) 不過這有時靈光有時不行,也不知道為甚麼...)

感激不盡!

弱女子留

樓主熱帖

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

2^#

發表於 2012-5-4 16:52 | 只看該作者

回復 1# sax868

不了解 2) 之說明

Sub xx()
Sheets("Updated Data").Select
Cells = ""
[A1] = Sheets("AB1").[B1]: [B1] = Sheets("AB1").[B2]: [C1] = Sheets("AB1").[D1]
[D1:BE1] = Sheets("AB1").[A11:BB11].Value
For Each Sh In Sheets
If Sh.Name = "Currency" Or Sh.Name = "DATA" Or Sh.Name = "Updated Data" Then Exit For
R = 0: C = 0
R = Sh.[A11].End(xlDown).Row: C = C + (R - 12 + 1)
Ar = Sh.Range("A12:BB" & R).Value
[D65536].End(xlUp).Offset(1, 0).Resize(C, 54) = Ar
Br = Array(Sh.[C1], Sh.[C2], Sh.[E1])
[A65536].End(xlUp).Offset(1, 0).Resize(C, 3) = Br
Next
End Sub

複製代碼

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

3^#

發表於 2012-5-4 17:28 | 只看該作者

回復 2# register313

感謝register313 大大的訊速回覆!
可是跑不出資料耶~請問這跟版本有關嗎? 我是用office2010, W7.
它顯示一個視窗寫: Can't execute code in break mode
我就自己加開一個工作表鍵入Updated Data 然後再跑一遍結果又出現: Run-time error '9': Subscript out of range
拜託救我...

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

4^#

發表於 2012-5-4 21:27 | 只看該作者

回復 3# sax868
確實無法了解你的需求
執行以下程序，自動生成新工作表，得到Updated Data的資料
再來討論你的第2個問題

Sub Ex()
Dim Sh As Worksheet, Ar()
For Each Sh In Sheets
With Sh
If UBound(Filter(Array("Currency", "DATA", "Updated Data"), .Name, True)) < 0 Then
ReDim Preserve Ar(57, x)
If IsEmpty(Ar(0, 0)) Then
Ar(0, x) = .[B1].Value: Ar(1, x) = .[B2].Value: Ar(2, x) = .[D1].Value
s = 3
For Each a In .[A11:BB11].Value
Ar(s, x) = a
s = s + 1
Next
x = x + 1
End If
r = 12
Do Until .Cells(r, 1) = ""
ReDim Preserve Ar(57, x)
Ar(0, x) = .[C1].Value: Ar(1, x) = .[C2].Value: Ar(2, x) = .[E1].Value
s = 3
For Each a In .Range(.Cells(r, "A"), .Cells(r, "BB")).Value
Ar(s, x) = a
s = s + 1
Next
x = x + 1: r = r + 1
Loop
End If
End With
Next
With Sheets.Add(after:=Sheets(Sheets.Count))
.[A1].Resize(x, 57) = Application.Transpose(Ar)
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

5^#

發表於 2012-5-6 01:03 | 只看該作者

回復 4# Hsieh

真不好意思~首先，感謝Hsieh大大的幫忙! 在這檔案可以用但是到我的檔案跑時它出現 Run-time error '13': Type mismatch
請問這是甚麼呢?

自動降級成幼稚園大班的
弱女子留

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

6^#

發表於 2012-5-6 01:45 | 只看該作者

回復 5# sax868
抱歉!又是我...
我剛剛有試著把 .[A1].Resize(x, 57) = Application.Transpose(Ar) 這一行拿掉.結果開了一個新的資料表但內容是空白...

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

7^#

發表於 2012-5-6 06:42 | 只看該作者

回復 6# sax868

這一行是寫入值的方法
出現錯誤可能是X=0吧
把出現錯誤的檔案上傳看看

學海無涯_不恥下問

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

8^#

發表於 2012-5-6 18:54 | 只看該作者

Desktop.zip (142.95 KB) 回復 7# Hsieh

謝謝Hsieh大的幫忙!真的很不好意思，因為這個檔案裡有很多別的檔案的連結跟其他前人寫的巨集(看不懂...)還有工作表也會隨MNo增加而增加，我有試著把一些工作表移除結果出現資料了，後來我把幾個跑不出資料的留住一些數據資料移除後本打算要寄給您參考，結果再跑一次居然出現資料了...

隨信附上這個出現"執行階段錯誤'13' : 型態不符合" 的數據給您供參考。
感激不盡!

幼稚園大班的
弱女子留

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

9^#

發表於 2012-5-6 23:09 | 只看該作者

回復 8# sax868
這種問題常發生在陣列元素的字元數超過256個字元所產生
導致無法正確操作陣列轉置
改成一一給值就可以

x = x + 1
End If
r = 12
Do Until .Cells(r, 1) = ""
ReDim Preserve Ar(57, x)
Ar(0, x) = .[C1].Value: Ar(1, x) = .[C2].Value: Ar(2, x) = .[E1].Value
s = 3
For Each a In .Range(.Cells(r, "A"), .Cells(r, "BB")).Value
Ar(s, x) = a
s = s + 1
Next
x = x + 1: r = r + 1
Loop
End If
End With
Next
With Sheets.Add(after:=Sheets(Sheets.Count))
For i = 0 To UBound(Ar, 2)
For j = 0 To 56
.[A1].Offset(i, j) = Ar(j, i)
Next
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

10^#

發表於 2012-5-7 22:55 | 只看該作者

本帖最後由 sax868 於 2012-5-8 12:10 編輯

not ok.rar (55.18 KB) 回復 9# Hsieh

感謝超級版主的救命之恩!! 超級好用!大概等2分鐘答案全跑出來，這真的太神奇了!!
接下來的第二個問題還得再煩請超級版主幫我解決...
我試著寫函數然後用錄巨集的方式可是無法每張工作表都一起改，以下是我的需求：
每一張工作表裡Filter(Array("Currency", "DATA", "Updated Data")的AI12至AI300值為:
若C1='Updated Data'裡的A:A欄且A12='Updated Data'!裡的D: D欄且J12='Updated Data'!裡的M:M欄，
則AI12值為'Updated Data'!AL:AL欄裡相對應的值，並且A12至A300值若為空格，AI12至AI300欄為空格，若有值則需計算；若AI12至AI300欄位值出現零則意將其值設為空格。

每一張工作表裡Filter(Array("Currency", "DATA", "Updated Data")的AU12至AU300值為:
若C1='Updated Data'裡的A:A欄且A12='Updated Data'!裡的D: D欄且J12='Updated Data'!裡的M:M欄，
則AI12值為'Updated Data'!AX:AX欄裡相對應的值，並且A12至A300值若為空格，AU12至AU300欄為空格，若有值則需計算；若AU12至AU300欄位值出現零則意將其值設為空格。

舉例: 煩請參考工作表'1033600-2013' AI12欄及AU12欄我的兩光函數這麼寫: =IF(A12="","",IF(AND(C1='Updated Data'!A2)+AND(A12='Updated Data'!D2)+AND(J12='Updated Data'!M2),'Updated Data'!AL2,"")) 可是這招再另一張工作表'1006600-2013'就不靈光...:L

*剛剛我用Index+match好像可以靈光了!
例工作表'1033600-2013' ：
AI12欄 {=IF(A12="","",INDEX('Updated Data'!AL:AL,MATCH($C$1&$A12&$J12,'Updated Data'!A:A&'Updated Data'!D: D&'Updated Data'!M:M,0)))}
AU12欄 {=IF(A25="","",INDEX('Updated Data'!AX:AX,MATCH($C$1&$A25&$J25,'Updated Data'!A:A&'Updated Data'!D: D&'Updated Data'!M:M,0)))}

可是不知為啥一定得在最後按Ctrl+Shift+Enter才能跑出數據,這函數直接複製貼AI13:AI300時全變'#VALUE!'...

以上，希望有解釋清楚...

拜託...請超級版主抽空及各位高手大大救救我!!

幼幼班的弱女子留:$

TOP