iT邦幫忙

0

Excel 有辦法將公式轉換成 VBA,以減少檔案大小,進而增加開啟速度嗎?

  • 分享至 

  • xImage

如題,我使用 Excel 2013。
可能因為儲存格使用到大量重複的公式,造成檔案肥大,如下圖,
於是每次開啟檔案都要等上 30分鐘...

https://ithelp.ithome.com.tw/upload/images/20190706/20118578cXhs5tDnI6.jpg

請問有方法將公式轉換成 VBA,以減少檔案大小,進而增加開啟檔案的速度嗎?

我使用公式=INDEX(A!$A$2:$A$100,MATCH(B!A1,A!$D$2:$D$100)+1,1),
欲完成不同表格間的比對和填值,說明如下:

step1. 將表 B儲存格 A1的值 =0.487971,在表 A的 D欄的值比對,
找到(表B, A1)=0.487971 >(表A, D15)=0.446153846。

step2. 依據 step1結果,找到表 A的 D15對應在 A欄的位置 A15,再+1=A16。

step3. 將表 A儲存格 A16的值,填入表 C的 A2儲存格。

依照前述步驟,繼續將表 B2的 A2的值,在表 A的 D欄的值比對,
找到對應在表 A 的 A欄的位置 +1後,再將儲存格的值填入表 C的 A3。
以此類推。

表Ahttps://ithelp.ithome.com.tw/upload/images/20190706/20118578k4MZzqg94G.jpg

表Bhttps://ithelp.ithome.com.tw/upload/images/20190706/20118578gmoC1hSRhj.jpg

表Chttps://ithelp.ithome.com.tw/upload/images/20190706/201185786N5TKj5kJ2.jpg

另外,附上問題舉例使用的檔案(檔案大小 12.9KB):https://drive.google.com/file/d/1W_VFzmJqCMEWHitCfXPFyxY6GpFnAYC1/view?usp=sharing

感謝大家的幫忙!祝平安喜樂。

看更多先前的討論...收起先前的討論...
froce iT邦大師 1 級 ‧ 2019-07-07 11:07:35 檢舉
你這種用法和用量,建議轉資料庫...
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-07 11:54:59 檢舉
我在網路爬文也是得到這樣的總結,用 ecxel去處理這樣大的資料量,實在是用錯工具。

但在我目前的狀況而言,因為是做社會科學研究 <<<文組人 Orz,只能想辦法用我僅有的 excel簡單知識,完成整理資料後,再使用 SPSS統計軟體接續我要做的分析...

我專心的焦點得放在後面的分析工作,實在沒辦法再分散心力,學習這些比較進階的程式工具的新知識,所以非常囧...

於是才厚著臉皮來大神聚落問問看,有沒有大神願意幫忙了...
froce iT邦大師 1 級 ‧ 2019-07-07 12:54:54 檢舉
這種情況就是研究經費拿出來找人幫忙寫,如果是學校單位的話,去徵個資工人來打工應該蠻好找的。
要不然就是去學access。

然後建議去找熟python或R的,搞不好連SPSS的錢都可以省下來,因為基本的工具都有函式庫了。
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-07 13:35:56 檢舉
嗯嗯,我也覺得理想情況下,可以這樣子當然最好。

其他學門的研究經費可能很充裕,實際我也不曉得。可惜的是,在社會科學的研究案,很多時候,就算是"中央"政府委託的研究案,預算也都非常、非常、非常拮据<<<(很重要,所以說三次)。

這種拮据的程度是,好一點的,我們一個月最多只有萬把元的薪資,但大多數情況是幾千元。

然後還要常常因為購買資料庫不夠錢,或者一些無法核銷的必要開銷,例如:和受訪者吃個簡餐建立關係,你總不好意思跟人家說,我們就來 AA制吧 XD。蠻多時候,還是得從自己的口袋掏錢拿出來運用。

所以,通常做這類研究是沒錢賺的,也很難有多餘經費用合理待遇,去找到其他專業加入,運氣差點可能還要倒貼一些... Orz

既然如此,又沒好處、吃力不討好,那又為什麼要溏這渾水?

某些人的動機是研究興趣、某些是人情壓力,也禁不起拜託、某些比較高尚,覺得自己應該為社會做點事...

最終,如果研究報告,可以在政府的施政上看到些改變成果,能夠讓普遍大眾皆能受益,當然很令人開心。

不過,也常常就算研究白皮書給出具體的結論和政策建議,也會因為政治上很多不為人知(或者,匪夷所思...)的考量,在結案後由政府收回成果,不曉得在什麼地方靜靜的躺著... 躺著... 躺著...,直到哪個掌權的有緣人看到它,才有機會看到些改變...

以上離題了,就是聊天一下。順便說說為什麼會採用如此不合理的方式,說難聽點就是想用 "伸手牌" XD,嘗試解決問題...
froce iT邦大師 1 級 ‧ 2019-07-07 14:33:28 檢舉
所以啦,那這種情況之下,除了你們自己辛苦一點,多學一點東西,好像也沒有解決法了不是嗎?

專業是有價的,做這種研究案的確很辛苦,但我今天可憐你的處境,把成品、甚至連原始碼都給你,改天你要做類似但是不同的分析時,你自己不會改,又跑來伸手...
你覺得這種關係會久遠嗎?如果你做這種論文/研究案如果只做一篇,這種伸手牌的策略或許可行。但如果你是以這種研究案為職業,那我真的建議自己學著建立工具或者建議系所招聘一個做資料整理工作,專門幫你們撰寫這類程式的人。

真的都沒辦法也只能接受現況,用沒效率的方式去做,沒辦法,台灣連規劃/研究政策的都沒認清「專業有價」的大環境,你一個人的確沒辦法改變啥。
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-07 15:32:48 檢舉
的確,大多數情況下,我們同儕間都是用很沒效率的方式去做,所以很感謝您提供的幫助!做這種政策研究,我自己是比較用志願服務的心態去參與 XD,在台灣要靠這餬口非常難,不如在私人企業上班。

我自己是覺得台灣社會現況,比表面上看得到的要慘得多啊,一大堆定時炸彈等著要爆,就等著看在誰手上爆炸而已...

也感謝您提供的建議,之後應該要找時間來學 Access的使用。
froce iT邦大師 1 級 ‧ 2019-07-07 17:04:54 檢舉
後藤新平名言:"台灣人民族性-愛錢、怕死、愛面子"
我只能說這真的是道盡目前社會的困境啊。

我自己也是在公部門任職,負責任的不多、愛面子的一堆。
有長遠眼光的更少...

回到正題:
Access是比較易用的有GUI介面的資料庫,但如果貴校有開什麼供學生去學的python資料分析課程,我是更建議去聽一聽。
目前大數據正流行,應該會有很多這種課程好利用。python也比一般程式語言好學,上次寫出來的code你也看到,比golang短很多、工具也更齊全。

另外文組學程式說不定更好學,程式寫多了你會發現其實就跟學語言沒兩樣,除非你寫底層,其他就是純粹的邏輯而已。
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-07 18:04:38 檢舉
哈哈,我也在基層單位待過幾年,但可能是我不適合公部門的工作文化,所以就跑了 XD

我會把 "台灣人民族性-愛錢、怕死、愛面子" 這句話,解釋成台灣人對於所在社會環境,認知到的不安全感,其實對每個人外顯的行為影響甚鉅。現在看起來,這種不安,搞不好還有代間複製的傾向...

python好像是當今顯學,身邊也是有朋友去學網路課程,意圖分析股市投資策略。就找時間來學看看了...
goodnight iT邦研究生 2 級 ‧ 2019-07-09 18:18:28 檢舉
excel 2010 以上的版本, 效率都很好了, 以 2016 版最好
也可以使用 libreoffice 來跑跑看
goodnight iT邦研究生 2 級 ‧ 2019-07-09 18:21:41 檢舉
請問表 B 的 ABCDE 欄, 分別要跟表A的 欄比對, 然後依序寫到 表C 的各欄嗎?
萬一 Ann +1 = 空白欄位呢??怎麼處理?
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-10 10:14:55 檢舉
在這個例子,我已經在表 B確保每個儲存格的值,不大於表 A的 D欄的最大值,所以不會遇到空白欄位的問題。

先前有遇到空白欄位,會導致回傳錯誤訊息,我是使用函數 IFERROR,遇到錯誤就直接在表 C的儲存格填入我指定的值,以下列公式為例,若遇到錯誤就填入表 A的 A3的值:=IFERROR(INDEX(A!$A$2:$A$100,MATCH(B!A1,A!$D$2:$D$100)+1,1),A!$A$3)
goodnight iT邦研究生 2 級 ‧ 2019-07-10 14:46:47 檢舉
不對啊, 依你的程序" 依據 step1結果,找到表 A的 D15對應在 A欄的位置 A15,再+1=A16" , 到了 A20 +1 = A21 就表示資料最後一筆, 是空白, 你怎麼處理?
goodnight iT邦研究生 2 級 ‧ 2019-07-10 16:04:21 檢舉
還有一點我看不懂,
step1. 將表 B儲存格 A1的值 =0.487971,在表 A的 D欄的值比對,找到(表B, A1)=0.487971 >(表A, D15)=0.446153846。
例, 表B(A1): 0.4879713 > 表A(D0): 0 好像跟你說的, 不太吻合比對的條件
因為 表B(A1): 0.4879713的值全大於表A(D2:D15), 你這樣的說法好像怪怪的

是不是應該是表A(D16):0.5384615385 > 表B(A1):0.487971, 然後把 表A(A16)寫到表C, 是這樣嗎?
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-10 16:43:47 檢舉
表 C儲存格 A2的公式是:
=IFERROR(INDEX(A!$A$2:$A$100,MATCH(B!A1,A!$D$2:$D$100)+1,1),A!$A$3)

把公式拆成三段來看:

1. MATCH(B!A1,A!$D$2:$D$100)+1,1)
我用 MATCH函數將搜尋類型指定為 1,在表A的D2:D100範圍,找小於或等於搜尋值(表B, A1)的最大值的位置,再加 1傳回下一個位置就是 B16。

2. INDEX(A!$A$2:$A$100,MATCH(B!A1,A!$D$2:$D$100)+1,1)
再用 INDEX公式傳回上一個公式得到的位置(表 A, B16),將其對應到表A的 A2:A100範圍的位置的值傳回,得到(表A, A16)的值 = 9。

3. IFERROR(INDEX(A!$A$2:$A$100,MATCH(B!A1,A!$D$2:$D$100)+1,1),A!$A$3)
在我的問題舉例中,表 B已 "確保不會有任何一個值大於表 A的 D欄的值",所以不擔心會有傳回值為空白的錯誤。如果表 B真的出現了大於表 A的D欄的最大值 1的值,我就用 IFERROR函數,讓公式傳回我指定的值,而不是錯誤訊息。在這條公式裡,我指定傳回表A的A3的值。
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

2 個回答

1
來杯拿鐵
iT邦新手 2 級 ‧ 2019-07-07 21:33:55
最佳解答

有點複雜有些地方可能理解錯誤。

問題

優化檔案開啟速度
有三張資料表
表A:來源資料表
表B:搜尋
表C:搜尋結果

在表A搜尋表B,產出結果表C。

解決方法

用公式查到值以後 > 選擇性貼上/值

https://ithelp.ithome.com.tw/upload/images/20190707/2009191024CSc8yETo.jpg

Sub 跨資料表查詢()

'宣告
    '資料表設定:表A,表B,表C
    Dim shA, shB, shC, fml As String
    shA = "A"
    shB = "A"
    shC = "A"

    '公式設定
    fml = "=INDEX($B$5:$B$9,MATCH(F5,$C$5:$C$9)+1,1)"
    
    '輸出範圍
    Set result = Sheets(shC).Range("I5: J7")
    
'處理過程
    endRow = result.Rows.Count
    result.Rows(1).Formula = fml
    
    For reRow = 2 To endRow
        result.Rows(1).Copy
        
        With result.Rows(reRow)
        .PasteSpecial
        .Copy
        .PasteSpecial Paste:=xlPasteValues
        End With
    Next reRow
    
    With result.Rows(1)
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With
    
End Sub
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-08 04:23:42 檢舉

感謝回答!原來公式可以這樣放上去 VBA啊~

我後來 google一些別人的例子,以原本的問題舉例檔案,
將表 B儲存格在欄和列的參照位置,用兩個迴圈去找:

Sub FindValue()

Dim SearchRange As Range
Dim ARow As Long
Dim BRow As Long
Dim BCol As Long
Dim CRow As Long
Dim CCol As Long
Dim BEndRow As Long
Dim BEndCol As Long
 
Set SearchRange = Sheets("A").Range("D2:D30")      ' 在表 A要查找的範圍

BCol = 1
CCol = 1

EndBCol = Range("A1").End(xlToRight).Column      ' 找表 B最後一欄的資料

Do Until BCol > EndBCol

BRow = 1
CRow = 2

EndBrow = Sheets("B").Range("A1").End(xlDown).Row      ' 找表 B最後一列的資料

Do Until BRow > EndBrow

For Each cell In SearchRange
If cell.Value > Sheets("B").Cells(BRow, BCol).Value Then
    ARow = cell.Row     ' 找(表 A, D2:D30) >表 B儲存格的值的位置
    Exit For
End If

Next

Sheets("C").Cells(CRow, CCol) = Sheets("A").Range("A" & ARow).Value     '把表 A, A欄的值填入表 C

BRow = BRow + 1
CRow = CRow + 1

Loop

BCol = BCol + 1
CCol = CCol + 1

Loop

End Sub

我也不確定這樣做是否正確?
不過可以順利執行預期完成的工作,
檔案也成功瘦身到原本的一半左右大小 XD

你可以玩看看「錄製巨集」

戴芄蘭 iT邦新手 5 級 ‧ 2019-07-08 18:00:13 檢舉

好的,感謝提供訊息。

0
goodnight
iT邦研究生 2 級 ‧ 2019-07-10 16:27:54

其實寫法很多種, 我也不是很熟, 我用最笨的寫法,
"來杯拿鐵"的比較符合你要的答案, 我是來串門子練功夫

還有一種做法是, 寫深一點, 程式寫在A活頁簿, 然後指定路徑+檔名, 去執行

Sub MAIN()

Dim rng As Object '物件
Dim dataRow As Integer '表B 的資料列數
Dim dataCol As Integer '表B 的資料欄數
Dim xRow As Integer '表B列, 用來循序讀取列資料
Dim xCol As Integer '表B欄, 用來循序移動欄座標讀取資料
Dim fData As Double '要比對的表B值
Dim fRow As Integer '比對表A值, 符合條件的列數
Dim dataEnd As Integer '表A 的資料列數
Dim cRow As Integer '要寫入表C 的列的位置

Application.ScreenUpdating = False ' 關閉螢幕的顯示

'--------------------------------------------------
'填入表C 的標題列, 有點多餘, 看你要不要用
Worksheets("表C").Range("A1").Value = "1A"
Worksheets("表C").Range("B1").Value = "1B"
Worksheets("表C").Range("C1").Value = "1C"
Worksheets("表C").Range("D1").Value = "1D"
Worksheets("表C").Range("E1").Value = "1E"
'--------------------------------------------------

' 切換到表A, 取得最後的資料列位置
Worksheets("表A").Activate
dataEnd = Cells(ActiveSheet.Rows.Count, "D").End(xlUp).Row

' 切換到表B 最後的資料列及欄位數
Worksheets("表B").Activate
dataRow = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row ' 取得資料最後列
dataCol = Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column ' 取得資料最右欄

For xCol = 1 To dataCol '表B 欄
    cRow = 1 '表C 的欄題列值, 0表示沒有標題列
    For xRow = 1 To dataRow ' 表B 列
        ' 取得表B RANGE(A1~A最後列)的值, CELLS(列, 欄), 例 CELLS(1, "A") = A1 或 CELLS(1,1) = A1
        fData = Worksheets("表B").Cells(xRow, xCol).Value

        ' 開始比對資料
        Worksheets("表A").Activate
        For Each rng In Range("D2:D" & dataEnd)
        
            If rng.Text > fData Then
               fRow = rng.Row ' 符合比對條件的資料列數值
               cRow = cRow + 1 ' 寫入表C的列數值
               ' 把指定的表A值填入表C
               Worksheets("表C").Cells(cRow, xCol).Value = Worksheets("表A").Cells(fRow, "A").Value
               Exit For '結束此次比對
            End If
        Next
        
        Worksheets("表B").Activate
    Next xRow
Next xCol

Application.ScreenUpdating = True

End Sub
goodnight iT邦研究生 2 級 ‧ 2019-07-10 16:39:59 檢舉

修正一下, 最底下

Worksheets("表C").Select
Range("A1").Select
Application.ScreenUpdating = True
戴芄蘭 iT邦新手 5 級 ‧ 2019-07-10 18:01:10 檢舉

感謝!
我來試試執行速度,會不會比我寫的快,哈哈。

goodnight iT邦研究生 2 級 ‧ 2019-07-10 20:56:39 檢舉

我的程式碼比較多, 一定會比較慢

我要發表回答

立即登入回答