怎么修改可以实现不删除旧的数据情况下，也能自动刷新

RexxarHuang

Private Sub Worksheet_Activate()
    Dim nR1%, arr(), nR2%, brr(), nL%, dRq As Date, dRq2 As Date, Crr()
    Dim ds As Object, n%, m%, s
    Set ds = CreateObject("Scripting.Dictionary")
    With Sheets("卓越销售流水")
        nR1 = .Range("c50000").End(xlUp).Row
        arr = .Range("c1:o" & nR1).Value
    End With
    With Sheets("销售人员每日业绩表")
        nR2 = .Range("b50000").End(xlUp).Row
        nL = .Range("xfd1").End(xlToLeft).Column
        Crr = .Range("b1").Resize(1, nL).Value
        If nR2 > 1 Then dRq = .Range("b" & nR2).Value
        For i = 2 To nL - 1
            ds(Crr(1, i)) = i
        Next
        ReDim brr(1 To nR1, 1 To 5)
        For i = 2 To nR1
            If arr(i, 1) > dRq Then
                If dRq2 <> arr(i, 1) Then
                    m = m + 1
                    brr(m, 1) = arr(i, 1)
                    dRq2 = arr(i, 1)
                End If
                s = arr(i, 9) / IIf(arr(i, 13) = "", 1, 2)
                For j = 12 To 13
                    If ds.exists(arr(i, j)) Then
                        n = ds(arr(i, j))
                        brr(m, n) = brr(m, n) + s
                    End If
                Next
            End If
        Next
        If m > 0 Then
            .Range("b" & nR2 + 1).Resize(m, nL - 1).Value = brr
        End If
    End With
    End Sub




现在源数据会有增加和减少，每一次销售人员的业绩表都需要删除一次数据才能刷新，怎么可以在不删除旧数据，只要源数据更新，这个工作表打开数据也跟着更新

liulang0808

感觉楼主的分享，建议上传模拟附件，便于大家对应理解

RexxarHuang

liulang0808 发表于 2020-2-3 19:14
感觉楼主的分享，建议上传模拟附件，便于大家对应理解

已经上传了，liulang 老大帮忙看看

SCL5801

分享贴？······