如何用VBA实现数据调用

RexxarHuang

sheet2中的数据来源于sheet1，sheet1 每天更新
sheet2在B列更新生成日期，
如果当天销售人是2个，那对应sheet2中的人名下的数据就是当天实收金额的汇总除以2
如果当天销售人是1个，那对应sheet2中的人名下的数据就是当天实收金额的汇总
例如
B列生成1月1日，C2就是150，D2就是150
B列生成了1月5日，C列对应就是909
B列生成了1月6日,C列对应就是150，D列是150，E列对应的是-100，F列对应是-100

山菊花

供参考。

RexxarHuang

山菊花 发表于 2020-1-22 15:15
供参考。

老师，如果sheet1的表，列的位置改变了，要怎么修改

山菊花

我不知你怎么变，没法准确回答你。
下面代码中的B、E就是列位置：
        Arr = .Range("b1:e" & nR1).Value

RexxarHuang

山菊花 发表于 2020-1-22 15:53
我不知你怎么变，没法准确回答你。
下面代码中的B、E就是列位置：
        Arr = .Range("b1:e" & nR1).V ...

就是变成是不连续的列，B列的日期要变成C列，实付金额的数据变到K列，销售人1，销售人2变成N和O列

RexxarHuang

山菊花 发表于 2020-1-22 15:53
我不知你怎么变，没法准确回答你。
下面代码中的B、E就是列位置：
        Arr = .Range("b1:e" & nR1).V ...

就是改成这样的情况下，代码要怎么修改

山菊花

Sub 更新()
    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("Sheet1")
        nR1 = .Range("c1048576").End(xlUp).Row
        Arr = .Range("c1:o" & nR1).Value
    End With
    With Sheets("Sheet2")
        nR2 = .Range("b1048576").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

RexxarHuang

山菊花 发表于 2020-1-22 17:21
Sub 更新()
    Dim nR1%, Arr(), nR2%, Brr(), nL%, dRq As Date, dRq2 As Date, Crr()
    Dim ds As O ...

老师我想问下，这个代码每次都要删除数据才能更新？？如果增删源数据怎么修改能更新

山菊花

没有理解你的意图。
如果sheet2每次更新要清除原有数据，可修改后面代码：
        If m > 0 Then
            .Range("b" & nR2 + 1).Resize(m, nL - 1).Value = Brr
        End If
改为：
        .UsedRange.Offset(1).ClearContents
        If m > 0 Then
            .Range("b2").Resize(m, nL - 1).Value = Brr
        End If

RexxarHuang

山菊花 发表于 2020-2-3 20:53
没有理解你的意图。
如果sheet2每次更新要清除原有数据，可修改后面代码：
        If m > 0 Then

因为现在的情况是，只要我要sheet1中增加或者减少数据的情况下，到sheet2点击更新，数据不会跟随着更新，只有把sheet2的数据清空了，再重新点击更新才可以