vba中vba字典汇总的几种"撸"法.至于怎么"撸

来源：蜘蛛抓取(WebSpider) 时间：2016-12-17 08:49 标签： vba 遍历字典
君，已阅读到文档的结尾了呢~~
excel VBA中关于dictionary字典用法的学习与笔记
扫扫二维码，随身浏览文档
手机或平板扫扫即可继续访问
VBA中关于dictionary字典用法的学习与笔记
举报该文档为侵权文档。
举报该文档含有违规或不良信息。
反馈该文档无法正常浏览。
举报该文档为重复文档。
推荐理由：
将文档分享至：
分享完整地址
文档地址：
粘贴到BBS或博客
flash地址：
支持嵌入FLASH地址的网站使用
html代码：
&embed src='/DocinViewer-4.swf' width='100%' height='600' type=application/x-shockwave-flash ALLOWFULLSCREEN='true' ALLOWSCRIPTACCESS='always'&&/embed&
450px*300px480px*400px650px*490px
支持嵌入HTML代码的网站使用
您的内容已经提交成功
您所提交的内容需要审核后才能发布，请您等待！
3秒自动关闭窗口VBA中字典的几种“撸”法..至于怎么“撸”？当然是看着以下的内容一起“撸”！(一)
VBA中字典的几种“撸”法..至于怎么“撸”？当然是看着以下的内容一起“撸”！(一)
一、结构异常 字典 数组棋盘法先上图&要求：1.给个选择区域窗口，只提取区域里面的数据，& && &2.按日期下面的4列从左到右,从上到下,提取完再提取下一个日期,(&&1,產品編號2,工單號碼3工單数量,4日期)3. 產品編號1005开头的不提取,4, 產品編號和工單號碼相同,的只留最早日期提取的结果：產品編號工單號碼工單数量日期-04B811047065001月10日-02T81094865001月10日-04T811047065001月10日Sub 提取数据2()On Error Resume NextDim rng As Range, arr, i, j, k, da As Date, brr() As Variant, 棋盘() As Variant, 行数 As Long, item As Long, dic As Object, NewSht As WorksheetDim rn As Range, rnn As Range, FirstMon As Integer, LastMon As Integer, 起始 As String, 终止 As StringWith Worksheets('SMT Schedule &(2)')& & &Set rng = .UsedRange& & &Set rn = .Range(.Range('a1'), .Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1))End Withone:& & 起始 = Application.InputBox('请输入起始日期，如“”', '请输入起始日期', '', , , , , 2)& & & & & &If 起始 = 'False' Then Exit Sub& & & & & &Set rnn = rn.Find(CDate(起始), , , xlWhole)& & & & & &If rnn Is Nothing Then MsgBox '起始日期不存在，请重新填写！', vbOKOnly
32, '错误': GoTo one Else FirstMon = rnn.Column& & & & & &two:& &终止 = Application.InputBox('请输入终止日期，如“”', '请输入终止日期', '', , , , , 2)& & & & & &If 起始 = 'False' Then Exit Sub& & & & & &Set rnn = rn.Find(CDate(终止), , , xlWhole)& & & & & &If rnn Is Nothing Then MsgBox '终止日期不存在，请重新填写！', vbOKOnly
32, '错误': GoTo two Else LastMon = rnn.Column
3arr = rng.Value '数组& & For j = FirstMon To LastMon& & & & & For i = 3 To UBound(arr)' & & & & & &If j = 34 Then Stop& & & & & & & If IsDate(arr(1, j)) Then da = arr(1, j) '如果是日期，则记录日期& & & & & & &&& & & & & & & If arr(i, 2) = '產品編號' And Len(arr(i, j)) & 0 Then& & & & & & & & &If Split(arr(i, j), '-')(0) = '1005' Then i = i
10: GoTo label& & & & & & & & &item = item
1& & & & & & & & &ReDim Preserve brr(1 To 4, 1 To item)& & & & & & & & &brr(1, item) = arr(i, j) '產品編號& & & & & & & ElseIf arr(i, 2) = '工單號碼' And Len(arr(i, j)) & 0 Then& & & & & & & & &brr(2, item) = arr(i, j) '工單號碼& & & & & & & ElseIf arr(i, 2) = '工單数量' And Len(arr(i, j)) & 0 Then& & & & & & & & &brr(3, item) = arr(i, j) '工單数量& & & & & & & & &brr(4, item) = da '日期& & & & & & & ElseIf arr(i, 2) = '產品編號' And Len(arr(i, j)) = 0 Then& & & & & & & & &i = i
10: GoTo label& & & & & & & End Iflabel:& & & & & Next& & Next& &&Set dic = CreateObject('scripting.dictionary') '创建字典对象& & For i = 1 To UBound(brr, 2)& & & & If dic.Exists(CStr(brr(1, i) & brr(2, i))) Then '如果字典中存在此关键字& & & & & & 行数 = dic(CStr(brr(1, i) & brr(2, i)))& & & & & & If CDate(棋盘(1, k)) & CDate(brr(4, i)) Then& & & & & & & & 棋盘(4, k) = 棋盘(4, k) '日期& & & & & & & & 棋盘(3, k) = 棋盘(3, k)
brr(3, i) '工單数量& & & & & & Else& & & & & & & & 棋盘(4, k) = brr(4, i) '日期& & & & & & & & 棋盘(3, k) = 棋盘(3, k)
brr(3, i) '工單数量& & & & & & End If& & & & Else & & & & & & & & & & & & & & &'否则& & & & & & k = k
1 '计算& & & & & & dic(CStr(brr(1, i) & brr(2, i))) = k '写入字典，关键为（產品編號、工單號碼），条目为计数& & & & & & ReDim Preserve 棋盘(1 To 4, 1 To k)& & & & & & 棋盘(1, k) = brr(1, i) '產品編號& & & & & & 棋盘(2, k) = brr(2, i) '工單號碼& & & & & & 棋盘(3, k) = brr(3, i) '工單数量& & & & & & 棋盘(4, k) = brr(4, i) '日期& & & & End If& & Next& &&& & Application.DisplayAlerts = False& & & & Worksheets('汇总').Delete& & Application.DisplayAlerts = True& &&& & Application.ScreenUpdating = False '关闭刷新& & & &Set NewSht = Worksheets.Add(After:=Worksheets(Worksheets.Count)) '新建工作表表& & & &With NewSht& & & & & & .Name = '汇总' '新建工作表命名为汇总& & & & & & .Range('a1:d1') = Array('產品編號', '工單號碼', '工單数量', '日期')& & & & & & .Range('a2').Resize(UBound(棋盘, 2), 4) = Application.WorksheetFunction.Transpose(棋盘) &'导出& & & & & & .Range(Range('d2'), Cells(Rows.Count, 'd').End(xlUp)).NumberFormatLocal = 'yyyy/m/d'& & & & & & .Range('a1').CurrentRegion.EntireColumn.AutoFit '自动列宽& & & & & & .Range('a1').CurrentRegion.Borders.LineStyle = xlContinuous '添加边框线& & & End With& & & & & Erase 棋盘 '清空数组& & Application.ScreenUpdating = True '开启刷新End Sub
发表评论：
TA的最新馆藏【撸】（擼）lū捋（lu?）：把树枝上的叶子撸下来。撤销（职务）：把他的队长给撸了。训斥，斥责：挨了一顿撸。笔画数：15；部首：扌；笔顺编号：511
以上内容是否解决了你的问题：
非常感谢您的反馈，我们会尽快解决该问题。
太简单，不清楚
太复杂，看不懂
不是我要的答案
您还可以输入140字
非常感谢您的反馈，我们会尽快解决该问题。
相同部首的字
相同笔画的字
相同读音的字
其它实用工具
本周点击量最多的字
大家正在搜索的字

我要回帖

更多关于 vba 遍历字典 的文章

 

随机推荐