123
返回列表 上一主題 發帖

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

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) 不過這有時靈光有時不行,也不知道為甚麼...)

感激不盡!

弱女子留
收藏 分享

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
21#
發表於 2012-5-18 17:05 | 只看該作者
  1. Sub SaveIt()
  2.     Msg = MsgBox("My Dear Friend，It's been a while，please press YES to save file!" & Chr(13) _
  3.        & "是(Y)：Save File" & Chr(13) _
  4.        & "否(N)：You Are in Trouble." & Chr(13) _
  5.        & "取消Cancel：Your Boss Is in Trouble.", vbYesNoCancel + 64, "Take a Break!")
  6. '提示用戶保存當前活動文檔。
  7.     If Msg = vbYes Then Application.Run "OutputtoUpdatedDataI" Else If Msg = vbCancel Then Exit Sub
  8.     ActiveWorkbook.Save
  9.     ActiveWorkbook.Worksheets("Updated Data").Copy
  10.     ActiveWorkbook.Worksheets("Updated Data").SaveAs "D:\" & "Updated Data" & ".xlsx"
  11.     ActiveWorkbook.Worksheets("Updated Data").SaveAs "D:\Updated Data " & Date$ & ".xlsx"
  12.     Call runtimer '如果用戶沒有選擇取消就再次調用 Runtimer
  13. End Sub
複製代碼
回復 20# Hsieh
搞定了!!
謝謝超級版主的指點!設定好了很好用喔!由於這個備份會把同檔案覆蓋上去，有許多幼幼班的使用者共同使用該檔，所以我也在另外設定儲存三個檔案(1.原檔、2.只有該工作表、3.只有該工作表+日期)，不過有1個小問題想麻煩請超級版處幫我解決:
1. 存'只有該工作表'在執行指令時會開起儲存後自動關閉，但'只有該工作表+日期'這個不會，請問要怎麼樣才能使2、3備份檔都在儲存後自動關閉呢? (我試了幾個方法但不靈光...有把3個檔都關掉也有3個檔都開起沒被關掉...-_-lll)

拜託您了!!
謝謝!

弱女子留

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
20#
發表於 2012-5-13 17:41 | 只看該作者
回復 19# sax868
至於你整體流程我並不清楚
自動存檔可參考下面連結
自訂Applicatoin事件/監控所有活頁簿/做成增益集
學海無涯_不恥下問

TOP

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
19#
發表於 2012-5-12 01:23 | 只看該作者
_VALUE!2.rar (119.74 KB) 回復 17# Hsieh

親愛的超級版主晚安：

因為這個檔案連結許多檔案，擔心會有其他使用者疏忽沒存檔以致遺失資料。我想了一些方法用三腳貓功夫寫了一套把檔案自動儲存的VBA(置於Model3裡)，但是不靈光，還得麻煩請超級版主幫忙修改導正：

AutoSaveNotes:請問如何用VBA設定在每15分鐘及關檔案時(這個我不會)會自動跳出視窗要求存檔一次 (按”是”後，跑該先前設置的動作一，除了要存在工作表’Updated Data’裡(先前是另開啟一個檔案旦發覺序號會跳將來沒辦法抓回去，所以直接存在Updated Data工作表裡即可)，並自動另存檔於路徑C:\Users\JH\Downloads\，其檔名為：Notes），該存為單一工作表之名稱亦為'Updated Data'。

以上，拜託超級版主救救我!!

謝謝~

眼睛花花的
弱女子留

TOP

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
18#
發表於 2012-5-10 20:06 | 只看該作者
回復 17# Hsieh
太感激您了!!叩謝超級版主的幫忙!!


   
滿心歡喜的
弱女子留

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
17#
發表於 2012-5-10 19:49 | 只看該作者
本帖最後由 Hsieh 於 2012-5-10 19:50 編輯

回復 16# sax868
  1. Sub InputData()

  3. Dim Sh As Worksheet, Ar()

  5. Set d = CreateObject("Scripting.Dictionary")

  7. Set d1 = CreateObject("Scripting.Dictionary")


  10. With Sheets("Updated Data")

  12.    For Each a In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))

  14.     If a.Offset(, 49) <> "" Then d(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 49).Value   'AX有值才執行

  16.     If a.Offset(, 37) <> "" Then d1(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 37).Value   'AL有值才執行

  18.    Next

  20. End With

  22. For Each Sh In Sheets

  24. With Sh

  26.    r = 12

  28.    Do Until .Cells(r, 1) = ""

  30.          .Cells(r, "AU") = d(.[C1] & .Cells(r, "A") & .Cells(r, "J"))

  32.          .Cells(r, "AI") = d1(.[C1] & .Cells(r, "A") & .Cells(r, "J"))

  34.           r = r + 1

  36.    Loop

  38. End With

  40. Next

  42. End Sub
複製代碼
學海無涯_不恥下問

TOP

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
16#
發表於 2012-5-10 17:13 | 只看該作者
#VALUE!.zip (131.44 KB) 回復 14# Hsieh

親愛的超級版主午安：

真不好意思! 請問在Input Data這個VBA中能不能在抓符合這三數值的同時，並需'Updated Data'AL欄或AX欄有值的才抓AL欄或AX欄的值?
With Sheets("Updated Data")
    For Each a In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
     d(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 49).Value
     d1(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 37).Value

目前我遇到的狀況是符合這三數值的可能有好幾列，但只有一列是有Notes,
           舉例(請查附件)：工作表‘1008600-2013’ 因’Updated Data”裡符合這特定三數值的(1008600+500+AA) 有三行但僅其中一行有Notes, 所以VBA跑出來答案是空白

現在我能想到的是先把這些空白的手動刪除後再跑InputData VBA即可求出答案，問題是這一刪有些資料在全部更新後就找不回來了…想請問能不能麻煩超級版主幫忙多設一個條件，使:
d(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 49).Value 符合外且AX欄非空格
d1(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 37).Value符合外且AL欄非空格

感激不盡!!

沒招了的
弱女子留:L

TOP

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
15#
發表於 2012-5-8 23:03 | 只看該作者
回復 14# Hsieh
我感動地大哭一場...
感謝超級版主的救命之恩...總算我可以從駝背又灰頭土臉到明天挺直腰桿活著走進辦公室了!!
說不盡的感激!!!

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
14#
發表於 2012-5-8 22:00 | 只看該作者
回復 13# sax868
  1. Sub InputData()
  2. Dim Sh As Worksheet, Ar()
  3. Set d = CreateObject("Scripting.Dictionary") '創建字典物件儲存"Updated Data"對應的值
  4. Set d1 = CreateObject("Scripting.Dictionary") '創建字典物件儲存"Updated Data"對應的值

  6. With Sheets("Updated Data")
  7.    For Each a In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
  8.      d(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 49).Value '以A、D、M為索引存入AX欄位的值
  9.      d1(a & a.Offset(, 3) & a.Offset(, 12)) = a.Offset(, 37).Value '以A、D、M為索引存入AL欄位的值
  10.    Next
  11. End With
  12. For Each Sh In Sheets
  13. With Sh
  14.    r = 12 '從第12列以下開始讀入資料到陣列中
  15.    Do Until .Cells(r, 1) = "" '直到A欄為空白為止
  16.          .Cells(r, "AU") = d(.[C1] & .Cells(r, "A") & .Cells(r, "J")) '將工作表的AU欄位寫入對應的Updated Data值
  17.          .Cells(r, "AI") = d1(.[C1] & .Cells(r, "A") & .Cells(r, "J")) '將工作表的AI欄位寫入對應的Updated Data值
  18.           r = r + 1 '下一列
  19.    Loop
  20. End With
  21. Next
  22. End Sub
複製代碼
學海無涯_不恥下問

TOP

sax868

帖子
37 
主題
9 
精華
0 
積分
61 
點名
0  
作業系統
Windows7 
軟體版本
office 2010 
閱讀權限
20 
性別
女 
註冊時間
2011-4-26 
最後登錄
2014-7-28 
13#
發表於 2012-5-8 21:31 | 只看該作者
回復 12# Hsieh

感謝超級版主的幫忙! 很抱歉，我這混亂地表達沒讓您立即清楚明瞭-_-lll
'Updated Data'裡的AL欄須對應到每一張工作表的12列以下之AI欄，'Updated Data'裡的AX欄須對應到每一張工作表的12列以下之AU欄；先前動作一的VBA與現在要抓Updated Data裡的AL/AX值回每個工作表的AI/AU為二個獨立分開的VBA喔! (因為突然發現它跑了一次資料)
真不好意思，要再麻煩您了!

幼幼班表達能力不佳的
弱女子留

TOP

        靜思自在 : 修行要繫緣修心，藉事練心，隨處養心。
123
返回列表 上一主題