楼主
liuguansky |
Q:公司要搭配舞伴，男女摇骰子，点数和为7的互为舞伴[以先出现的和为7的异性为准],最后按舞伴里最早出现的人来排序。
A：用如下代码可以实现：- Sub justtest()
- '前期绑定字典对象，引用VBE工具下MS SCRIPTING.RUMTIME
- Const K% = 7
- '定义常量数组 点数和为7
- Dim Arr(), Ar, i&, arrt() As New Dictionary, j As Byte
- Dim t&, ArrR(), A, B, t1
- '定义变量
- Application.ScreenUpdating = False
- '关闭屏幕刷新
- t1 = Timer
- ReDim Arr(1 To K - 1)
- '定义点数数组
- Ar = Range("A1").CurrentRegion.Value
- '获取摇点信息入数组
- For i = 1 To K - 1
- '点数重建男女子字典
- ReDim arrt(1 To 2)
- Set arrt(1) = New Dictionary
- Set arrt(2) = New Dictionary
- Arr(i) = arrt
- Next i
- For i = 2 To UBound(Ar, 1) '循环记录
- j = IIf(Ar(i, 2) = "男", 1, 2) '判断男女用于返回对应子字典
- With Arr(K - Ar(i, 3))(3 - j) '引用匹配子字典对象
- If .Count > 0 Then '如果存在记录，则返回匹配结果
- t = t + 1 '累加匹配记录数
- ReDim Preserve ArrR(1 To 3, 1 To t) '动态定义结果数组
- A = .Keys: B = .Items '引用子字典数据
- ArrR(3, t) = B(0) '赋值结果数组各项目
- ArrR(j, t) = Ar(i, 1)
- ArrR(3 - j, t) = A(0) '引用行号，作为排序关键字
- .Remove A(0) '移除第一个匹配结果
- Else '否则
- Arr(Ar(i, 3))(j).Add Ar(i, 1), i '添加自身入子字典KEY
- End If
- End With
- Next i
- Range("e2:f" & Rows.Count).ClearContents
- With Range("e2").Resize(t, 3)
- .Value = Application.Transpose(ArrR) '返回结果数组
- .Sort Range("g2"), xlAscending, Header:=xlNo '按标识位排序
- End With
- Range("g:g").Clear
- Application.ScreenUpdating = True
- MsgBox "配对成功。" & vbCrLf & "用时：" & Format(Timer - t1, "0.00000秒"), vbOKOnly
- End Sub
|