iT邦幫忙

0

EXCEL函數設太多狂當機，求VBA解決

求救啊! vba
Et5205750 2022-02-15 14:43:45 ‧ 814 瀏覽

  • 分享至 

  • xImage

=IF(B6="","",SUM(($V$1<='D:\6.辦公室自動化[績效輸入介面_大隊.xlsx]各隊個人績效'!$A$2:$A$58278)('D:\6.辦公室自動化[績效輸入介面_大隊.xlsx]各隊個人績效'!$A$2:$A$58278<=$Z$1)('D:\6.辦公室自動化[績效輸入介面_大隊.xlsx]各隊個人績效'!$C$2:$C$58278=B6)*('D:\6.辦公室自動化[績效輸入介面_大隊.xlsx]各隊個人績效'!D$2:D$58278)))
$V$1,$Z$1是判斷日期，資料比對是B6：B400，在c欄產生加總各隊個人績效'!D$2:D$58278，
在e欄產生加總各隊個人績效'!e$2:e$58278，在g欄產生加總各隊個人績效'!f$2:f$58278，在i欄產生加總各隊個人績效'!g$2:g$58278，在k欄產生加總各隊個人績效'!h$2:h$58278，在m欄產生加總各隊個人績效'!i$2:i$58278，在o欄產生加總各隊個人績效'!j$2:j$58278，在q欄產生加總各隊個人績效'!k$2:k$58278，在s欄產生加總各隊個人績效'!l$2:l$58278，在u欄產生加總各隊個人績效'!m$2:m$58278，在w欄產生加總各隊個人績效'!n$2:n$58278，
如下圖，可以用VBA的方式嗎？因為EXCEL函數太多會當機，拜託IT先進幫忙診斷

rogeryao iT邦超人 7 級 ‧ 2022-02-15 14:57:44 檢舉
不會吧，把機關單位跟姓名都貼出來 ?
登入發表討論
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

1 個回答

1
海綿寶寶
iT邦大神 1 級 ‧ 2022-02-15 16:34:33

如下圖，可以用VBA的方式嗎？

可以
不過也請貼一下「6.辦公室自動化[績效輸入介面_大隊.xlsx]各隊個人績效」的樣子
如果有空的話
建議先看看「樞紐分析」的功能合不合用
不用急著寫 函數/VBA

在c欄產生加總各隊個人績效'!D$2:D$58278，
在e欄產生加總各隊個人績效'!e$2:e$58278，
在g欄產生加總各隊個人績效'!f$2:f$58278，
在i欄產生加總各隊個人績效'!g$2:g$58278，
在k欄產生加總各隊個人績效'!h$2:h$58278，
在m欄產生加總各隊個人績效'!i$2:i$58278，
在o欄產生加總各隊個人績效'!j$2:j$58278，
在q欄產生加總各隊個人績效'!k$2:k$58278，
在s欄產生加總各隊個人績效'!l$2:l$58278，
在u欄產生加總各隊個人績效'!m$2:m$58278，
在w欄產生加總各隊個人績效'!n$2:n$58278，

c,e,g,i...都是「件數」而非「分數」
確定沒錯嗎

因為EXCEL函數太多會當機

當機可能有別的原因
如果真是因為函數太多
那就可以上新聞爆料了
/images/emoticon/emoticon64.gif

VBA 已寫好，測試結果如下
執行前
https://ithelp.ithome.com.tw/upload/images/20220215/20001787MLfQjuotqd.pnghttps://ithelp.ithome.com.tw/upload/images/20220215/20001787khUPdpbI04.png
執行後
https://ithelp.ithome.com.tw/upload/images/20220215/200017877cX1kQ59zP.png

資料筆數：10000筆
執行時間：2分50秒
/images/emoticon/emoticon06.gif

海綿寶寶 iT邦大神 1 級 ‧ 2022-02-16 08:36:41 檢舉

VBA 如下
請在「統計表」工作表執行 Main 即可

Sub Main()
    '設定值
    detailSheet = "個人績效表"
    
    mainSheet = ActiveSheet.NAME
    dateFrom = Range("V1").Value
    dateTo = Range("Z1").Value
    
    '主程式
    Application.ScreenUpdating = False
    
    Sheets(detailSheet).Select
    Range("A2").Select
    Do While ActiveCell.Value <> ""
        Application.StatusBar = "Processing " & ActiveCell.Row
        If (ActiveCell.Value >= dateFrom) And (ActiveCell.Value <= dateTo) Then
            nameCell = findNAME(ActiveCell.Offset(0, 2))
            If nameCell <> "N/A" Then
                Sheets(mainSheet).Range(nameCell).Offset(0, 1).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 1).Value + ActiveCell.Offset(0, 3).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 3).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 3).Value + ActiveCell.Offset(0, 4).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 5).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 5).Value + ActiveCell.Offset(0, 5).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 7).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 7).Value + ActiveCell.Offset(0, 6).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 9).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 9).Value + ActiveCell.Offset(0, 7).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 11).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 11).Value + ActiveCell.Offset(0, 8).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 13).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 13).Value + ActiveCell.Offset(0, 9).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 15).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 15).Value + ActiveCell.Offset(0, 10).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 17).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 17).Value + ActiveCell.Offset(0, 11).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 19).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 19).Value + ActiveCell.Offset(0, 12).Value
                Sheets(mainSheet).Range(nameCell).Offset(0, 21).Value = Sheets(mainSheet).Range(nameCell).Offset(0, 21).Value + ActiveCell.Offset(0, 13).Value
            End If
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
    Application.ScreenUpdating = True
    
    Sheets(mainSheet).Select
End Sub
Function findNAME(NAME As String) As String
    Dim rng As Range
    Dim sheetStatistic As String
    Dim rangeName As String
    
    '設定值
    sheetStatistic = "統計表"
    rangeName = "B:B"
    
    With Worksheets(sheetStatistic).Range(rangeName)
        Set rng = .Find(NAME, LookIn:=xlValues)
        If Not rng Is Nothing Then
            findNAME = rng.Address
        Else
            findNAME = "N/A"
        End If
    End With
End Function
blanksoul12 iT邦研究生 5 級 ‧ 2022-02-16 10:21:35 檢舉

放 array 之後一次直接掉會否放一點? sql 又會否再快一點?

登入發表回應

我要發表回答

立即登入回答
iT+看影片追技術 看影片追技術 看更多
熱門tag 看更多
15th鐵人賽 13th鐵人賽 14th鐵人賽 12th鐵人賽 11th鐵人賽 鐵人賽 2019鐵人賽 2018鐵人賽 javascript 2017鐵人賽 python windows php c# windows server linux css react 程式設計 vue.js
熱門問題
熱門回答
熱門文章
IT邦幫忙