|
Sub jav()
Dim arr, d, r, ky, i, j, brr(), k, sh, shh, n
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
n = 1
With Sheets("汇总")
arr = .Range("a1:g" & .Cells(Rows.Count, "c").End(xlUp).Row)
End With
For r = 4 To UBound(arr)
d(arr(r, 3)) = ""
Next
ky = d.keys
For i = 0 To d.Count - 1
Set shh = Sheets.Add(after:=Sheets("汇总"))
With shh
.Name = ky(i)
With shh.[a1]
.Value = ky(i) & "的疫情趋势"
.Resize(1, 5).Merge
.Font.Size = 18
.Font.Bold = True
End With
End With
shh.[a2].RowHeight = 3
shh.[a1].HorizontalAlignment = xlCenter
Next
For j = 1 To Sheets.Count
For k = 4 To UBound(arr)
If Sheets(j).Name = arr(k, 3) Then
n = n + 1
ReDim Preserve brr(1 To 5, 1 To n)
brr(1, 1) = "日期": brr(2, 1) = "新增病例": brr(3, 1) = "累计病例": brr(4, 1) = "累计死亡": brr(5, 1) = "累计治愈"
brr(1, n) = arr(k, 2)
brr(2, n) = arr(k, 4)
brr(3, n) = arr(k, 5)
brr(4, n) = arr(k, 6)
brr(5, n) = arr(k, 7)
End If
Next
If Sheets(j).Name <> "汇总" Then Sheets(j).[a3].Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
n = 1
Next
Application.ScreenUpdating = True
End Sub |
|