=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先進幫忙診斷
已邀請的邦友 {{ invite_list.length }}/5
如下圖，可以用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函數太多會當機
當機可能有別的原因
如果真是因為函數太多
那就可以上新聞爆料了
VBA 已寫好，測試結果如下
執行前
執行後
資料筆數：10000筆
執行時間：2分50秒
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
放 array 之後一次直接掉會否放一點? sql 又會否再快一點?
iThome鐵人賽
看影片追技術