VBA 彙總統計

Option Explicit


Sub sum_Click()
  Call loop_cells
End Sub


Sub loop_cells()
   Dim mysheet As Worksheet
   Set mysheet = ActiveWorkbook.Sheets(1)
 
   Dim r As Long
    
' 站點
   Dim cell_zd As String
' 雨量
   Dim cell_yl As Single
' 數據年月
   Dim cell_ny As String
   '
   Dim k_zd_ny As String
   
   
   Dim dict
   Set dict = CreateObject("Scripting.Dictionary")
   
   Dim dict_zhandian
   Set dict_zhandian = CreateObject("Scripting.Dictionary")
   
       
   For r = 2 To mysheet.UsedRange.Rows.Count
     cell_zd = mysheet.Cells(r, 1).Value
     cell_ny = CStr(mysheet.Cells(r, 2).Value) & "年" + CStr(mysheet.Cells(r, 3).Value) & "月"
     cell_yl = mysheet.Cells(r, 5).Value
     
     k_zd_ny = cell_zd + "_" + cell_ny
     
     If Not dict_zhandian.exists(cell_zd) Then
       dict_zhandian.Add (cell_zd), cell_yl
       dict.Add (k_zd_ny), cell_yl
     Else
       dict_zhandian.Item(cell_zd) = cell_yl + dict_zhandian.Item(cell_zd)
       dict.Item(k_zd_ny) = cell_yl + dict.Item(k_zd_ny)
     End If
   
   Next
      
  
   
   Dim st As Worksheet
   Set st = ActiveWorkbook.Sheets(2)
   st.Cells.ClearContents
      
   Dim k, v, k1, v1
   k = dict_zhandian.Keys
   v = dict_zhandian.Items
   k1 = dict.Keys
   v1 = dict.Items
   
   
   st.Cells(1, 1).Value = "站點名"
   st.Cells(1, 2).Value = "年降水（" + CStr(mysheet.Cells(3, 2).Value) + ")"
   
   
   Dim nMonth As Integer
   
   For nMonth = 1 To 12
    st.Cells(1, 2 + nMonth).Value = CStr(nMonth) & "月"
   Next
      
   Dim i As Integer
   For i = 0 To dict_zhandian.Count - 1
   
     st.Cells(i + 2, 1).Value = k(i)
     t.Cells(i + 2, 2).Value = v(i)
     
     For nMonth = 1 To 12
       st.Cells(i + 2, 2 + nMonth).Value = dict.Item(k(i) + "_" + CStr(mysheet.Cells(3, 2).Value) + "年" + CStr(nMonth) + "月")
     Next
     
          
   Next
   
   st.Activate
End Sub

下載地址：下載