如何将汇总表内的数据自动更新到相应的sheet中

yunfeiying

如何将汇总表内的数据自动更新到相应的sheet中

yunfeiying

高手在吗？

yunfeiying

不知道为什么

提问技巧

1.提问之前可以先在论坛搜索相关帖子

2.提问的时候尽量问题说明白点 要有效果图 有表格附件

3.如果别人帮你解决了问题一定要记得回复别人结果 和说声谢谢 有鲜花的话也可以送几朵

4.问题解决后你可以学习别人解决问题的方法

[新手必读]发帖须知、上传附件、截图动画、压缩解压、靓帖推荐：
http://club.excelhome.net/thread-184567-1-1.html

Excel Home论坛学习及使用完全攻略(新人必读)：
http://club.excelhome.net/thread-449518-1-1.html

EH技术论坛的最佳学习方法：
http://club.excelhome.net/thread-117862-1-1.html

笨鸟飞不高

海外疫情趋势.zip (109.47 KB, 下载次数: 28)

2020-3-18 00:49 上传

点击文件名下载附件

模拟了一个，如果符合楼主的要求，请送上一朵花花！！

vic9

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

vic9

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

yunfeiying

谢谢啦