Sub test()Dim arr(), d As Object, key$, i%arr = Range("A1").CurrentRegion.ValueSet d = CreateObject("Scripting.Dictionary")For i = 2 To UBound(arr)If Len(arr(i, 1)) > 0 Thenkey = arr(i, 1)If Not d.exists(key) Then Set d(key) = CreateObject("Scripting.Dictionary")End Ifd(key)(arr(i, 3)) = ""NextDim brr(), lst(), n%, sr$brr = Range("F1").CurrentRegion.ValueRandomizeFor i = 2 To UBound(brr)key = brr(i, 1): lst = d(key).keysn = Int(d(key).Count * Rnd)brr(i, 2) = lst(n)d(key).Remove lst(n)NextRange("F1").Resize(UBound(brr), UBound(brr, 2)) = brrEnd Sub
第3行：数据装入数组
第4行：创建字典
第5行：循环数据源A列
第6行：数据长度大于0则装入字典
第7-8行：如果字典中该关键字不存在，则加入字典，并对该项进行创建二层字典
第10行：将小分类装进二层字典
第14行：将结果区域装入数组
第15行：重置随机发生器
第16行：循环结果区域数组
第17行：将小分类的数据源装入数组
第18行：随机抽取一个一到小分类数量的随机数
第19行：将该抽取结果装入结果数组第二行
第20行：使用字典的remove方法移除二层字典的该分类项
第23行：将结果数组导入区域
好了，本期教程就到这里啦，走过路过的点个关注分享一下吧，谢谢啦,如果你是一个VBA小白，想要了解该如何开始学习VBA，建议看看以下文章
Excel VBA学习路线知识框架梳理(小白VBA入门必看-建议收藏）
