请教关于字典提取（类似洗牌，取出之后逐渐减少）

张劲松2024

shiruiqiang

先写入字典，取出字典后，remove dic

张劲松2024

谢谢，刚开始学习字典，无从下手，有时间请帮帮忙！

ykcbf1100

楼主并没有说清楚，你每次取出6个，取出的数据放哪里呢？只取出B列数据呢还是连同C列一起取出呢？

shiruiqiang

张劲松2024

B、C列同时取出，放在D、E列

张劲松2024

完全是我的意图，太感谢了！！！！！！！！！

大灰狼1976

我感觉等价于先把数组顺序随机打乱，再6个一组顺序取出，剩余不足6个全部取出，不需要字典，也不需要随机取6次。

ZHLK

Sub test1()
Dim brr(1 To 6) As String
Dim d As Dictionary
arr = Range("B1:c" & Cells(Rows.Count, 1).End(xlUp).Row).Value   '赋值盒号所在列非空行的值给数组arr
u = UBound(arr)                                                  '数组arr的个数u
Set d = CreateObject("scripting.dictionary")                     '建立字典
'  Set d = New Dictionary
  For i = 2 To u
    d(i) = arr(i, 1) & "-" & arr(i, 2)
  Next i
a = d.Count
  
For i = 1 To Int(a / 6)
   For j = 1 To 6
        str1 = d.Keys
        b = Application.WorksheetFunction.RandBetween(1, UBound(str1))
        brr(j) = d(str1(b - 1))
        d.Remove (str1(b - 1))
        a = d.Count
        Debug.Print "第" & i & "批", j, brr(j)
   Next j
Next i
'余下部分
str1 = d.Items
For i = 0 To UBound(str1)
    brr(i + 1) = str1(i)
    Debug.Print "第" & Int((UBound(arr) - 1) / 6) + 1 & "批", i + 1, brr(i + 1)
Next i

End Sub

wanghui834

取出来的key值是知道的，dic.remove (key)