ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 290|回复: 10

[求助] 如何用VBA实现数据调用

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-22 14:45 | 显示全部楼层 |阅读模式
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


111.rar

8.56 KB, 下载次数: 5

TA的精华主题

TA的得分主题

发表于 2020-1-22 15:15 | 显示全部楼层
供参考。

RexxarHuang_111.rar

17.33 KB, 下载次数: 11

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-22 15:46 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-1-22 15:53 | 显示全部楼层
我不知你怎么变,没法准确回答你。
下面代码中的B、E就是列位置:
        Arr = .Range("b1:e" & nR1).Value

评分

参与人数 1鲜花 +2 收起 理由
RexxarHuang + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

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

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

TA的精华主题

TA的得分主题

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

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

RexxarHuang_111.rar

19.39 KB, 下载次数: 6

TA的精华主题

TA的得分主题

发表于 2020-1-22 17:21 | 显示全部楼层
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

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-3 20:27 | 显示全部楼层
山菊花 发表于 2020-1-22 17:21
Sub 更新()
    Dim nR1%, Arr(), nR2%, Brr(), nL%, dRq As Date, dRq2 As Date, Crr()
    Dim ds As O ...

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

TA的精华主题

TA的得分主题

发表于 2020-2-3 20:53 | 显示全部楼层
没有理解你的意图。
如果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

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-4 11:00 | 显示全部楼层
山菊花 发表于 2020-2-3 20:53
没有理解你的意图。
如果sheet2每次更新要清除原有数据,可修改后面代码:
        If m > 0 Then

因为现在的情况是,只要我要sheet1中增加或者减少数据的情况下,到sheet2点击更新,数据不会跟随着更新,只有把sheet2的数据清空了,再重新点击更新才可以
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-6-1 11:29 , Processed in 1.109496 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表