Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2287|回复: 7

[已解决]请教根据客户姓名查询客户购买明细的VBA写法

[复制链接]
发表于 2016-4-5 12:04 | 显示全部楼层 |阅读模式
本帖最后由 cylxf 于 2016-4-5 12:06 编辑

       如下面的文件,有客户的购买明细表。现在想实现,输入客户的名称,则自动将明细表中客户最近的购买明细自动复制在查询表中,并按时间从新到旧排列。最多复制20条记录即可。
       哪位大神帮助一下?不胜感谢!
客户.rar (3.85 KB, 下载次数: 13)
发表于 2016-4-5 13:16 | 显示全部楼层    本楼为最佳答案   
本帖最后由 yorkchenshunan 于 2016-4-5 13:18 编辑
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Address = "$A$2" Then
  3. Range("a6:c65535").ClearContents
  4. Dim ar, br, n, m
  5.     If Application.WorksheetFunction.CountIf(Sheets("明细").Range("a:a"), Target) Then
  6.         ar = Sheets("明细").Range("a1").CurrentRegion
  7.         ReDim br(1 To UBound(ar), 1 To 3)
  8.         For n = 1 To UBound(ar)
  9.             If ar(n, 1) = Target Then
  10.                 m = m + 1
  11.                 br(m, 1) = ar(n, 2)
  12.                 br(m, 2) = ar(n, 3)
  13.                 br(m, 3) = ar(n, 4)
  14.             End If
  15.         Next n
  16.         Range("a6").Resize(m, 3) = br
  17.     Else
  18.         MsgBox "查无此人"
  19.     End If
  20. End If
  21. End Sub
复制代码

客户.rar

12.06 KB, 下载次数: 36

回复

使用道具 举报

 楼主| 发表于 2016-4-5 16:35 | 显示全部楼层
yorkchenshunan 发表于 2016-4-5 13:16

太棒啦,杠杠的。
改改哪个地方就能实现最多20条?
回复

使用道具 举报

发表于 2016-4-5 17:21 | 显示全部楼层
Range("a6").Resize(m, 3) = br
改成
Range("a6").Resize(20, 3) = br
回复

使用道具 举报

 楼主| 发表于 2016-4-5 17:23 | 显示全部楼层
本帖最后由 cylxf 于 2016-4-5 17:34 编辑
yorkchenshunan 发表于 2016-4-5 17:21
Range("a6").Resize(m, 3) = br
改成
Range("a6").Resize(20, 3) = br

谢谢!
又试了一下,还有个问题,如果不到20行的话会出错。
回复

使用道具 举报

发表于 2016-4-5 17:39 | 显示全部楼层
Range("a6").Resize(IIf(m > 20, 20, m), 3) = br
回复

使用道具 举报

 楼主| 发表于 2016-4-5 17:49 | 显示全部楼层
yorkchenshunan 发表于 2016-4-5 17:39
Range("a6").Resize(IIf(m > 20, 20, m), 3) = br

完美了!
回复

使用道具 举报

 楼主| 发表于 2016-4-7 18:49 | 显示全部楼层
老大现在在否?那个程序还有一点小问题,就是提取的数据不是倒叙的(时间最新的再前),改成只显示20行以后,只有老的数据了。咋修改呢?
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 23:04 , Processed in 0.384261 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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