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

sax868

Notes adding.zip (221.94 KB)

VBA
下載次數: 14

2012-5-4 11:44

各位高手大大好:

請問以下要如何分別撰寫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

回復 1# sax868

不了解 2) 之說明

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

複製代碼

sax868

回復 2# register313

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

Hsieh

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

1. Sub Ex()
   
2. Dim Sh As Worksheet, Ar()
   
3. For Each Sh In Sheets
   
4. With Sh
   
5.   If UBound(Filter(Array("Currency", "DATA", "Updated Data"), .Name, True)) < 0 Then
   
6.   ReDim Preserve Ar(57, x)
   
7.   If IsEmpty(Ar(0, 0)) Then
   
8.      Ar(0, x) = .[B1].Value: Ar(1, x) = .[B2].Value: Ar(2, x) = .[D1].Value
   
9.      s = 3
   
10.      For Each a In .[A11:BB11].Value
    
11.         Ar(s, x) = a
    
12.         s = s + 1
    
13.      Next
    
14.      x = x + 1
    
15.    End If
    
16.    r = 12
    
17.    Do Until .Cells(r, 1) = ""
    
18.       ReDim Preserve Ar(57, x)
    
19.          Ar(0, x) = .[C1].Value: Ar(1, x) = .[C2].Value: Ar(2, x) = .[E1].Value
    
20.          s = 3
    
21.          For Each a In .Range(.Cells(r, "A"), .Cells(r, "BB")).Value
    
22.             Ar(s, x) = a
    
23.             s = s + 1
    
24.          Next
    
25.          x = x + 1: r = r + 1
    
26.    Loop
    
27.   
    
28.   End If
    
29. End With
    
30. Next
    
31. With Sheets.Add(after:=Sheets(Sheets.Count))
    
32. .[A1].Resize(x, 57) = Application.Transpose(Ar)
    
33. End With
    
34. End Sub

複製代碼

sax868

回復 4# Hsieh

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

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

sax868

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

Hsieh

回復 6# sax868


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

sax868

Desktop.zip (142.95 KB)

2 files
下載次數: 5

2012-5-6 18:52

回復 7# Hsieh

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

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

幼稚園大班的
弱女子留

Hsieh

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

1.      x = x + 1
   
2.    End If
   
3.    r = 12
   
4.    Do Until .Cells(r, 1) = ""
   
5.       ReDim Preserve Ar(57, x)
   
6.          Ar(0, x) = .[C1].Value: Ar(1, x) = .[C2].Value: Ar(2, x) = .[E1].Value
   
7.          s = 3
   
8.          For Each a In .Range(.Cells(r, "A"), .Cells(r, "BB")).Value
   
9.             Ar(s, x) = a
   
10.             s = s + 1
    
11.          Next
    
12.          x = x + 1: r = r + 1
    
13.    Loop
    
14.   End If
    
15. End With
    
16. Next
    
17. With Sheets.Add(after:=Sheets(Sheets.Count))
    
18. For i = 0 To UBound(Ar, 2)
    
19.    For j = 0 To 56
    
20.    .[A1].Offset(i, j) = Ar(j, i)
    
21.    Next
    
22. Next
    
23. End With
    
24. End Sub

複製代碼

sax868

not ok.rar (55.18 KB)

Step 2
下載次數: 2

2012-5-7 22:54

回復 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!'...

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

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

幼幼班的弱女子留:$