Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 151|回复: 3

[求助] 请高手帮忙看这代码怎么写

[复制链接]
发表于 2017-6-19 21:20 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程

请帮忙看下附件中想要达成的结果,应该写怎么样的VBA.谢谢!

请教.zip

270.65 KB, 下载次数: 9

发表于 2017-6-20 11:14 | 显示全部楼层
同一工单号同一日期是否会出现同样的规格型号?
回复 支持 反对

使用道具 举报

发表于 2017-6-20 11:32 | 显示全部楼层
按照不会出现同样型号写了段,看看是否ok吧!
  1. Sub test()
  2.     Dim d As Object
  3.     Dim ar, br(1 To 10000, 1 To 3)
  4.     Dim sr As String
  5.     Dim i As Long, j As Long
  6.     Set d = CreateObject("scripting.dictionary")
  7.     ar = Cells(1, 1).CurrentRegion
  8.     j = 1
  9.     br(j, 1) = "工单单号": br(j, 2) = "工单日期": br(j, 3) = "规格型号"
  10.     For i = 2 To UBound(ar)
  11.         sr = ar(i, 2) & vbTab & ar(i, 3)
  12.         If d.exists(sr) Then
  13.             br(d(sr), 3) = br(d(sr), 3) & "," & ar(i, 6)
  14.         Else
  15.             j = j + 1
  16.             d.Add sr, j
  17.             br(j, 1) = ar(i, 2)
  18.             br(j, 2) = ar(i, 3)
  19.             br(j, 3) = ar(i, 6)
  20.         End If
  21.     Next i
  22.     With Cells(1, 17)
  23.         .Resize(Rows.Count).ClearContents
  24.         .Resize(j, 3) = br
  25.     End With
  26. End Sub
复制代码


回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-6-20 19:18 | 显示全部楼层
windyjw007 发表于 2017-6-20 11:32
按照不会出现同样型号写了段,看看是否ok吧!

谢谢帮助,学习了。
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2017-8-21 23:47 , Processed in 0.093600 second(s), 19 queries , Gzip On, Memcache On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

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