VBA抽签分组立即显示队名到分组中去

odyssey166

各位老师：
       新年好！

       这是一个抽签分组的表格例子（见附件），因抽签完毕马上要打印给各队，所以要求咫尺天涯核对完成并打印结果 ，故求代码实现：比如在辅助表的队名下的“B”后的组次填入3，立即在打印的表格队名部分将队名"B"填入到第3组的第1个，接下来在“G”后面填入3，则将G填入第3组的第2个位，依此 类推，将第3个、第4个3对应的队名，根据填入3的先后顺序填入到打印的表格中去，同理，当填入1和填入2时也遵循上述的规则。
（如sheets(抽签表（理想结果））中的例子)

麻烦各位老师了。

祝老师们新年快乐！

一把小刀闯天下

'看不太懂，先猜一个，，，

Option Explicit

Sub test()
  Dim arr, i, j, k, t, p, n
  With Sheets("抽签表 (理想结果)")
    arr = .Range("a3:d" & .Cells(Rows.Count, "b").End(xlUp).Row + 1)
    For i = 1 To UBound(arr, 1) - 1
      arr(i, 3) = Val(Mid(arr(p + 1, 1), 2))
      n = n + 1: arr(i, 4) = n
      If Len(arr(i + 1, 1)) > 0 Or i = UBound(arr, 1) - 1 Then p = i: n = 0
    Next
    For i = 1 To UBound(arr, 1) - 2
      For j = i + 1 To UBound(arr, 1) - 1
        If StrComp(arr(i, 2), arr(j, 2), vbTextCompare) = 1 Then
          For k = 1 To UBound(arr, 2)
            t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
          Next
        End If
      Next
    Next
    For i = 1 To UBound(arr, 1) - 1
      arr(i, 1) = arr(i, 2): arr(i, 2) = arr(i, 3)
      arr(i, 3) = Format(arr(i, 4), "第0个") & arr(i, 2)
    Next
    .[e3].Resize(UBound(arr, 1), 3) = arr
  End With
End Sub

odyssey166

一把小刀闯天下 发表于 2020-1-28 12:19
'看不太懂，先猜一个，，，

Option Explicit

谢谢老师的回复。

可能是我描述得不清楚，让老师理解有偏差了。

像例子中，所有参赛的队名已经在E列放好，抽签时，会一个队一个队抽签（本例中签号为1-3），抽到几，就是第几组，就往第几组填入到B列中去，（如果同是第3组，那么先抽到3的队名放在上面，后抽到的队名放到下面，直到放满第3组的4个名额为止）。

odyssey166

odyssey166 发表于 2020-1-28 13:29
谢谢老师的回复。

可能是我描述得不清楚，让老师理解有偏差了。

补充一下：（1）抽签时，并不一定是按E列的上下顺序进行抽签的，E列的任何一支队都有可能是第1个抽签。（2）某队抽出分组后，马上将该队抽出的组号填写到F列的队名后方  （3）填写了数字后，希望马上能在B列的相应组次内看到该队的名字

liulang0808

1. Sub 按钮1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     y = 1
   
4.     Z = 4
   
5.     arr = [e2:g14]
   
6.     For j = 2 To UBound(arr)
   
7.         d(arr(j, 1)) = j
   
8.     Next j
   
9.     brr = [a2:b14]
   
10.     For j = 1 To d.Count
    
11.         x = WorksheetFunction.RandBetween(0, d.Count - 1)
    
12.         brr(j + 1, 2) = d.keys()(x)
    
13.         c = d.items()(x)
    
14.         arr(c, 2) = y
    
15.         If j Mod Z = 0 Then
    
16.             arr(c, 3) = "第" & Z & "个" & y
    
17.             y = y + 1
    
18.         Else
    
19.             arr(c, 3) = "第" & j Mod Z & "个" & y
    
20.         End If
    
21.         d.Remove d.keys()(x)
    
22.     Next j
    
23.     [e2:g14] = arr
    
24.     [a2:b14] = brr
    
25. End Sub
    

复制代码

liulang0808

附件内容供参考，看看是否满足需求

odyssey166

liulang0808 发表于 2020-1-28 18:45
附件内容供参考，看看是否满足需求

谢谢老师的回复。

您这个是让F列的数据随机生成的，而我们赛前的分组不是随机生成，而是队伍一个一个抽签抽出来的。所以F列的数字是手工填入进去的。

因这个表是要现场投影到大屏上，让参赛队知道即使的抽签结果，所以是希望在某队后面填入组次数后，马上能将队名显示到相应的组次中。

您做得其他都满足要求，就是F列的数据要手工录入，而不是随机生成

liulang0808

表格事件，供参考。。。。

odyssey166

liulang0808 发表于 2020-1-28 20:10
表格事件，供参考。。。。

太感谢了！
就是这样的效果！

祝老师新快乐！心想事成！

odyssey166

odyssey166 发表于 2020-1-28 20:16
太感谢了！
就是这样的效果！

老师你好：

昨天您解决了我的问题。

可否再追问一个问题：昨天是1个项目进行抽签，如果是两个项目抽签时，表格是如附件中排列的，那么应该如何做到呢？（具体见附件）