[發問] 如何使用vba做更快速的計算

1.rar (567.37 KB)
想請問各位大大們，目前附件中的excel資料是使用函數做計算，但速度很慢且容易出錯，想嘗試使用vba去做更快速的計算，也有買書回來研究，但"有看沒有懂"，不知各位大大們，是否可以幫忙解決問題??
主要是想把'2015生產日報表統計'中的數量做統計，因每天可能有數筆不同的資料，想統計各項原料的使用量，所以要區分為每日、每月及每年，謝謝各位~~

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2833
主題: 10
精華: 0
積分: 2889
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-17

2^#

發表於 2015-10-23 14:00 | 只看該作者

本帖最後由准提部林於 2015-10-23 14:01 編輯

沒有簡便寫法，只能逐一套，
有點複雜，請自行慢慢研究，程式碼太多，無法一一解說：
　
Sub 統計()
Dim j&, k&, Arr, Brr, R&, C&, LB, Day1&, Day2&
Dim Crr, Drr, iDate, DV&, D&, M&, SS
With Sheets(1).UsedRange.Offset(1, 0)
　　Arr = .Columns("C"):    R = UBound(Arr) - 1
　　Brr = .Columns("N:DU"):  C = UBound(Brr, 2)
　　Day1 = CDate(Left(.Parent.Name, 4) & "/1/1")
　　Day2 = CDate(Left(.Parent.Name, 4) & "/12/31")
　　DV = Day2 - Day1 + 1
End With
　
ReDim Crr(1 To DV, 1 To C), Drr(1 To 12, 1 To C)
For j = 2 To R
　　iDate = Arr(j, 1): If Not IsDate(iDate) Then GoTo 101
　　If iDate < Day1 Or iDate > Day2 Then GoTo 101
　　D = iDate - Day1 + 1:  M = Month(iDate)
　　For k = 1 To C
　　　　SS = Crr(D, k) + Brr(j, k)
　　　　If SS <> 0 Then Crr(D, k) = SS
　　　　SS = Drr(M, k) + Brr(j, k)
　　　　If SS <> 0 Then Drr(M, k) = SS
　　Next k
101: Next j
　
With Sheets("數量統計")
　　.UsedRange.EntireRow.Delete
　　.[B1].Resize(R, C) = Brr: .[A1] = "生產日期"
　　.[A1].Resize(R) = Arr
　　.[A1].Resize(R).NumberFormatLocal = "yyyy/mm/dd"
　　With .Cells(R + 1, 1).Resize(1, C + 1)
　　　　.Formula = "=IF(COLUMN()=1,""TOTAL"",SUM(A2:A" & R & "))"
　　　　.Borders(xlEdgeTop).LineStyle = xlContinuous
　　　　.Borders(xlEdgeBottom).LineStyle = xlDouble
　　End With
End With
　
With Sheets("日期統計")
　　.UsedRange.EntireRow.Delete
　　.[B1].Resize(1, C) = Brr: .[A1] = "生產日期"
　　.[A2].Resize(DV, 1) = "=" & Day1 & "+ROW(A1)-1"
　　.[A2].Resize(DV, 1).NumberFormatLocal = "yyyy/mm/dd"
　　.[B2].Resize(DV, C) = Crr
　　With .Cells(DV + 2, 1).Resize(1, C + 1)
　　　　.Formula = "=IF(COLUMN()=1,""TOTAL"",SUM(A2:A" & DV + 1 & "))"
　　　　.Borders(xlEdgeTop).LineStyle = xlContinuous
　　　　.Borders(xlEdgeBottom).LineStyle = xlDouble
　　End With
End With
　
With Sheets("月份統計")
　　.UsedRange.EntireRow.Delete
　　.[B1].Resize(1, C) = Brr: .[A1] = "生產月份"
　　.[A2].Resize(12) = "=TEXT(ROW(A1),""00月"")"
　　.[B2].Resize(12, C) = Drr
　　With .Cells(14, 1).Resize(1, C + 1)
　　　　.Formula = "=IF(COLUMN()=1,""TOTAL"",SUM(A2:A13))"
　　　　.Borders(xlEdgeTop).LineStyle = xlContinuous
　　　　.Borders(xlEdgeBottom).LineStyle = xlDouble
　　End With
End With
End Sub
　
附檔下載：

Xl0000147(數量統計).rar (27.39 KB)
　

TOP

ting870520