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