谁知道这个天气统计的VBA代码如何写？

rzqf

1、如何使用VBA代码，实现全年月份统计；见附件样表，，如左侧一月份表那样，，，将十二个月逐一统计显示出来。。。

ykcbf1100

快下班了，先标记一下吧。

liulang0808

考虑下遍历+字典进行汇总求和之类的
https://club.excelhome.net/threa ... tml?_dsign=b73ad3d6
https://club.excelhome.net/threa ... tml?_dsign=070dfca3

3190496160

遍历工作表，数组+字典，可以搞定，先留个记号吧

鄂龙蒙

【2022年天气统计】.rar (55.04 KB, 下载次数: 22)

2022-12-5 19:37 上传

点击文件名下载附件

fzxba

1. Sub test1()
   
2.   Dim ar(), br(), cr, Dict As Object
   
3.   Dim i As Long, j As Integer, n As Long, sKey As String
   
4.   Dim r As Long, c As Integer, p As Long, posRow As Long
   
5.   
   
6.   Worksheets("全年统计").Activate
   
7.   Cells.Clear
   
8.   Application.ScreenUpdating = False
   
9.   
   
10.   posRow = 1
    
11.   Set Dict = CreateObject("Scripting.Dictionary")
    
12.   cr = Split("月份天数 最高气温 最低气温 晴天日 雨天日")
    
13.   ReDim br(1 To 34, 1 To (UBound(cr) + 1) * 2)
    
14.   For j = 0 To UBound(cr)
    
15.     br(2, j * 2 + 1) = cr(j)
    
16.     br(3, j * 2 + 1) = Split("最高气温℃ 最低气温℃ 天气 风向 风力")(j)
    
17.     br(3, (j + 1) * 2) = "天数"
    
18.   Next
    
19.   ReDim ar(2 To Worksheets.Count)
    
20.   For n = LBound(ar) To UBound(ar)
    
21.     ar(n) = br
    
22.     With Worksheets(n)
    
23.       ar(n)(1, 1) = "2022年" & .Name & "份天气情况统计表"
    
24.       With .Range("F2", .Cells(.Rows.Count, "A").End(xlUp))
    
25.         cr = .Value
    
26.         ar(n)(2, 4) = WorksheetFunction.Max(.Columns(2))
    
27.         ar(n)(2, 6) = WorksheetFunction.Min(.Columns(3))
    
28.         ar(n)(2, 8) = WorksheetFunction.CountIf(.Columns(4), "晴")
    
29.         ar(n)(2, 10) = WorksheetFunction.CountIf(.Columns(4), "*雨*")
    
30.       End With
    
31.     End With
    
32.     For j = 2 To UBound(cr, 2)
    
33.       r = 3
    
34.       c = (j - 1) * 2
    
35.       Dict.RemoveAll
    
36.       For i = 1 To UBound(cr)
    
37.         If IsDate(cr(i, 1)) Then
    
38.           sKey = Trim(cr(i, j))
    
39.           If Dict.Exists(sKey) Then
    
40.             p = Dict(sKey)
    
41.             ar(n)(p, c) = ar(n)(p, c) + 1
    
42.           Else
    
43.             r = r + 1
    
44.             ar(n)(r, c - 1) = sKey
    
45.             ar(n)(r, c) = 1
    
46.             Dict.Add sKey, r
    
47.           End If
    
48.           If j = 2 Then ar(n)(2, 2) = ar(n)(2, 2) + 1
    
49.         End If
    
50.       Next
    
51.     Next
    
52.     With Range("A" & posRow)
    
53.       .Resize(UBound(ar(n)), UBound(ar(n), 2)) = ar(n)
    
54.       With .CurrentRegion
    
55.         Intersect(.Offset(0), .Offset(1)).Borders.LineStyle = xlContinuous
    
56.         .HorizontalAlignment = xlCenter
    
57.       End With
    
58.       .Font.Size = 14
    
59.       .Font.Bold = True
    
60.       .Resize(, UBound(ar(n), 2)).HorizontalAlignment = 7
    
61.     End With
    
62.     posRow = Range("A1").Resize(Rows.Count, UBound(ar(n), 2)).Find("*", , , , 1, 2).Row + 2
    
63.   Next
    
64.   Set Dict = Nothing
    
65.   
    
66.   Application.ScreenUpdating = True
    
67.   Beep
    
68. End Sub

复制代码

fzxba

2022年天气统计.rar (58.54 KB, 下载次数: 16)

2022-12-5 20:01 上传

点击文件名下载附件

清风竹-

一键生成统计表。

rzqf

鄂龙蒙 发表于 2022-12-5 19:17

谢谢，效果达到，学习。

rzqf

清风竹- 发表于 2022-12-5 20:15
一键生成统计表。

谢谢，效果很好，学习。