ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 785|回复: 7

[求助] 求大拿给写个查询的vba程序

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-9-24 09:09 | 显示全部楼层 |阅读模式
附件中的测试表每天按照日期会同步各个城市的销量以及各个城市的库存,因为销量表中没有库存,现在想把库存表中的BB类库存按照相同的日期,相同的地区匹配到对应的销量表中。请教大拿给写一个匹配语句。如下图,需要将“库存表"中各地区每一天的库存“BB”中的数值填写到销量表中对应的库存列中。日期,地区对应即可。
谢谢各路大拿先

销量表

销量表

库存表

库存表
test0924.rar (27.69 KB, 下载次数: 10)


TA的精华主题

TA的得分主题

发表于 2019-9-24 09:32 | 显示全部楼层
以地点、日期作为关键字把库存数据做个字典,然后到销售量表里匹配填写即可

TA的精华主题

TA的得分主题

发表于 2019-9-24 09:33 | 显示全部楼层
Sub a()
Dim arr, brr
Dim i%, j%, s$
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
'数据源
arr = Sheets(2).Range("a1").CurrentRegion
For i = 3 To UBound(arr)             '遍历行
    For j = 2 To UBound(arr, 2)     '遍历列
            If arr(2, j) = "BB" Then
                s = arr(i, 1) & "|" & arr(1, j - 1)      '条件,
                d(s) = arr(i, j)       '结果
            End If
    Next
Next
'查询区域
With Sheets(1)
    brr = .Range("A1:e" & Range("a" & Rows.Count).End(xlUp).Row)
    For i = 2 To UBound(brr)               '遍历行
        s = brr(i, 1) & "|" & brr(i, 2)       '条件,与上面一致
        If d.Exists(s) Then brr(i, 5) = d(s)
    Next
    '生成位置
    .[a1].CurrentRegion.Offset(1, 4).ClearContents          '清除内容,结果列
    .[a1].Resize(UBound(brr), UBound(brr, 2)) = brr         '写入结果
End With
Set d = Nothing
End Sub

TA的精华主题

TA的得分主题

发表于 2019-9-24 09:45 | 显示全部楼层
本帖最后由 opiona 于 2019-9-24 10:08 编辑
  1.     Set SHX = Worksheets("销量表")
  2.     Set SHD = Worksheets("库存表")
  3.    
  4.     SHX.Range("D2:D1048576").ClearContents
  5.     MAXROW = SHX.Range("A1048576").End(3).Row
  6.     For IROW = 2 To MAXROW
  7.         Rem  提示信息,在状态栏显示
  8.         Application.StatusBar = "北极狐提示: 总数:" & MAXROW - 1 & "    当前是第:" & IROW - 1 & "    当前日期是:" & SHX.Cells(IROW, 1).Value & "    当前城市是:" & SHX.Cells(IROW, 2).Value
  9.         DoEvents
  10.         
  11.         Rem 每一个销售值,查询对应日期
  12.         Set C = SHD.Range("A:A").Find(SHX.Cells(IROW, 1).Value, , LOOKAT:=xlWhole)
  13.         If Not C Is Nothing Then
  14.             Rem 找到城市
  15.             For ICOL = 2 To SHD.Range("IT2").End(xlToLeft).Column Step 5
  16.                 If SHD.Cells(1, ICOL).Value = SHX.Cells(IROW, 2).Value Then
  17.                     Rem 找到BB
  18.                     SHX.Cells(IROW, 5).Value = SHD.Cells(C.Row, ICOL + 1).Value
  19.                     Rem 退出,找下一行
  20.                     Exit For
  21.                 End If
  22.             Next
  23.         End If
  24.     Next
复制代码

TA的精华主题

TA的得分主题

发表于 2019-9-24 09:46 | 显示全部楼层
本帖最后由 opiona 于 2019-9-24 10:10 编辑

QQ14885553.rar (39.38 KB, 下载次数: 7)

TA的精华主题

TA的得分主题

发表于 2019-9-24 09:50 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
Sub KunCun()
  Dim Arr, Brr
  Dim m, n, p
  Dim L%
  Arr = Range("a2:c" & Range("a2").End(xlDown).Row)
  ReDim Crr(1 To UBound(Arr))
  Brr = Sheets("库存表").Range("a1:bs" & Sheets("库存表").Range("a2").End(xlDown).Row)
  For m = 2 To UBound(Arr, 1)
      For n = 1 To UBound(Brr, 2)
         If Arr(m, 2) = Brr(1, n) Then L = n + 1
      Next n
         For p = 2 To UBound(Brr, 1)
         If Arr(m, 1) = Brr(p, 1) Then Arr(m, 3) = Brr(p, L)
         Next p
Next m
    Range("e2:e10000") = ""
    Range("e2").Resize(UBound(Arr), 1) = Application.Index(Arr, , 3)
End Sub

TA的精华主题

TA的得分主题

发表于 2019-9-24 09:59 | 显示全部楼层
没有用字典,用数组做的,参考。
Sub KunCun()
  Dim Arr, Brr
  Dim m, n, p
  Dim L%
  Arr = Range("a2:c" & Range("a2").End(xlDown).Row)
  ReDim Crr(1 To UBound(Arr))
  Brr = Sheets("库存表").Range("a1:bs" & Sheets("库存表").Range("a2").End(xlDown).Row)
  For m = 1 To UBound(Arr, 1)
      For n = 1 To UBound(Brr, 2)
         If Arr(m, 2) = Brr(1, n) Then L = n + 1
      Next n
         For p = 3 To UBound(Brr, 1)
         If Arr(m, 1) = Brr(p, 1) Then Arr(m, 3) = Brr(p, L)
         Next p
Next m
    Range("e2:e10000") = ""
    Range("e2").Resize(UBound(Arr), 1) = Application.Index(Arr, , 3)
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-24 11:15 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
感谢以上各位大神的帮忙。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 13:48 , Processed in 0.053539 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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