当前在五列中有大约32k个数字。数字范围为1-47。希望获得每两位数字组合的计数:
NUMB_1 NUMB_2 NUMB_3 NUMB_4 NUMB_5 NUMB_6
2 4 5 14 21 38
10 23 26 30 40 46
1 10 25 37 43 47
16 18 23 24 38 40
1 15 18 21 28 39
9 11 13 19 38 39
2 6 9 25 27 45
2 20 24 28 35 47
3 4 25 30 36 45
11 18 20 25 27 30
2 6 7 36 45 47
尝试获取每个可能的两位数组合的计数
1&2, 1&3, 1&4 thru 1-47
2&3, 2&4, 2&5 thru 2-47
3&4, 3&5, 3&6 thru 3-47
以及所有数字
40&47, 41&47, 42&47, 43&47, 44&47, 45&47, 46&47
答案 0 :(得分:0)
您可以使用字典创建非常快速的质量计数。遍历数组而不是重复读取工作表将加快处理速度。
Option Explicit
Sub num_and_num_count()
Dim i As Long, j As Long, m As Long, n As Long, cmbo As String
Dim arr As Variant, nums As Object
Set nums = CreateObject("scripting.dictionary")
With Worksheets("sheet5")
arr = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "F").End(xlUp)).Value2
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
For m = LBound(arr, 1) To UBound(arr, 1)
For n = LBound(arr, 2) To UBound(arr, 2)
If arr(i, j) < arr(m, n) Then
cmbo = Format(arr(i, j), "00") & Format(arr(m, n), "00") & _
Join(Array(arr(i, j), arr(m, n)), Chr(38))
nums.Item(cmbo) = nums.Item(cmbo) + 1
End If
Next n
Next m
Next j
Next i
.Cells(1, "H").Resize(1, 2) = Array("combinations", "count")
.Cells(2, "H").Resize(nums.Count, 1) = Application.Transpose(nums.keys)
.Cells(2, "I").Resize(nums.Count, 1) = Application.Transpose(nums.items)
With .Range(.Cells(2, "H"), .Cells(.Rows.Count, "I").End(xlUp))
.Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
.Columns(1).TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(4, 1))
End With
End With
End Sub