从 VBA Excel 中的二维数组构建数字链
Build a chain of numbers from 2d array in VBA Excel
有一个 table 有数字。看
Attachment
第一列作为索引。它的编号为 0。
它决定跳转到哪一行。
行中输入了一个数字 select。
根据这个数字，转到有这个数字的行。
我们 select 来自新行的数字等等。
限制。
数字在过渡期间不重复
return到初始号只能在过渡号上等于table中的行数。
有必要根据 table 中的数字构建最长可能的转换链。理想情况下，循环，即当初始数等于最终数时，过渡次数等于行数。
例如，让我们从数字 1 开始。
第一行包含唯一的数字 - 74。转到第 74 行。
在第 74 行 select 第一列中的数字（零列是行编号索引）。第 74 行第一列没有任何内容，因此我们在后面的列中进一步查看。在第 2 列中有一个数字 46。转到第 46 行。
第 46 行第一列有一个数字 19。转到第 19 行。
等等
如果不可能select这样的数字不重复，那就输出原来是文件的序列。
然后寻找其他方法来实现最长的转换链。
如果代码可以返回一、二、...n 步并选择不同的路径，那就太好了。例如，在第一遍中，代码选择了行中的第一个数字并遇到了死胡同，然后返回并 selects 第二或第三个并再次重复。
我对如何在代码中执行此操作知之甚少。
充其量，我希望代码建议如何修复输入 table 以获得完整的序列。也就是说，代码会建议在哪个单元格中更改数字以循环序列。
我手动检查了这个 table 并发现至少有两个序列在第 86 步循环（现在 table 中有 86 行），但附加代码给出的最大值为 73步骤。
我在 Excel 中写了 VBA 代码。你可以在下面看到它。
完整 xls Drive.Google。
请告诉我如何解决这个问题。
如果这样的问题不能用VBA解决，请给我一个建议，我应该使用哪种编程语言。
Function IsUnique(ByRef intArr() As Integer, intNum As Integer) As Boolean
Dim intPart() As Integer
ReDim intPart(1 To UBound(intArr)) As Integer
For i = 1 To UBound(intArr)
intPart(i) = intArr(i)
Next
QuickSortInteger intPart
If (BinarySearchInteger(intPart, intNum) = -1) And (intNum <> 0) Then
IsUnique = True
Else
IsUnique = False
End If
End Function
Sub Main()
Dim varIData() As Variant
Dim intTemp(1 To 7) As Integer
Dim intTempWOZeros() As Integer
Dim intTempDSC(1 To 7) As Integer
Dim intTempCount As Integer
Dim intStore() As Integer
Dim intIData(1 To 86, 1 To 7) As Integer
Dim intBegin As Integer
Dim intCurr As Integer
Dim str As String
Sheets("For_Macros").Select
' Reads the given Excel table in a two-dimensional array
varIData = Range("B1:H86").Value
' In the cycle, the data from the Variant-array tranfer to Integer-array, empty values is replaced by zeros
For i = 1 To 86
For j = 1 To 7
If varIData(i, j) = "" Then
intIData(i, j) = 0
Else
intIData(i, j) = CInt(varIData(i, j))
End If
Next
Next
' Searching for other paths of the solution
' Reverse input array. The fisrt element became the last and the last - the first.
' For i = 1 To 86
' For j = 1 To 7
' intTemp(8 - j) = intIData(i, j)
' Next
'
' For j = 1 To 7
' intIData(i, j) = intTemp(j)
' Next
' Next
' Sort rows entire values - ascending
' I tried to change an order in numbers in each row
' For i = 1 To 86
' For j = 1 To 7
' intTemp(j) = intIData(i, j)
' Next
'
' QuickSortInteger intTemp()
'
' For j = 1 To 7
' intIData(i, j) = intTemp(j)
' Next
' Next
' Sort rows entire values - descending
' I tried to change an order in numbers in each row
' For i = 1 To 86
' For j = 1 To 7
' intTemp(j) = intIData(i, j)
' Next
'
' QuickSortInteger intTemp()
'
' For j = 1 To 7
' intTempDSC(8 - j) = intTemp(j)
' Next
'
' For j = 1 To 7
' intIData(i, j) = intTempDSC(j)
' Next
' Next
' The 1st For
For Z = 1 To 86 ' Top level.
' 'For ... next' for each start number
' At the first iteration we take the number 1 and begin
' form the 1st row, to build a sequence much posible as can
' At the 2nd iteratoin we take number two as the first number and begin
' form the 1st row, to build a sequence much posible as can
' We try go through the array every time starting with new row
' and do until we can add in a sequence new unique number
i = Z
ReDim Preserve intStore(1) ' Array in which we collect all number in a sequence
intStore(1) = i ' Array initialization with value = i, just like starting with the i-th line,
' and at i-th number we can not returm until amount of collecting number
' will be less than an amount of rows in intIData-array
' If intIData-array has got 100 row, then we can return
' at the begining row (wherever it be the 1st, the 49th or the 93th) at 100th iteration only
m = 0
' The 2nd For
For k = 1 To 85
ReDim Preserve intStore(k + 1)
intStore(k + 1) = -1
' We search any non-zero value
' We take this number from row selected from intIData
m = 1
intTempCount = 0
' Count amount of zeros
' Discard zeros
' Copy one row form 2d-array to 1d-array. 1d-array consists 1 row from intIData data-array
' The 3rd For
For count = 1 To 7
intTemp(count) = intIData(i, count)
Next
' The 3rd For End
' Count amount of zeros. We arrange the array so that it initially contains non-zero values
intTempCount = AllZerosAtEnd(intTemp())
ReDim intTempWOZeros(1 To intTempCount)
' Transferring to an array without zeros
' The 4th For
For count = 1 To intTempCount
intTempWOZeros(count) = intTemp(count)
Next
' The 4th For End
intCurr = intTempWOZeros(1)
m = 1
Povtor:
If IsUnique(intStore, intCurr) Then ' We check the uniqueness of the selected number if unique put it in the output array intStore
intStore(k + 1) = intCurr
i = intCurr ' and assign the variable i the value of this unique number, the next iteration of the loop will already analyze the string with this number
Else
If m <= intTempCount Then ' if there are still numbers in the intTempWOZeros row-array, then view other columns
' The 5th For
For j = m To intTempCount ' select the next value from the array, increase m by 1 and exit the loop back to check the uniqueness
intCurr = intTempWOZeros(j)
m = j + 1
GoTo Povtor
Next ' The 5th For End
Else
GoTo Metka
End If
End If
Next
' The 2nd For End
Metka: ' To fill Excel sheet Search results, sheet created manually
Sheets("PathOrder").Select
Range("A1").Select
ActiveCell.Cells(3, Z).Select ' Applied from the 3rd line,
' in the first line is for an amount of found numbers
' the 2nd line is the blank
' The 6th For
For x = 1 To UBound(intStore)
If intStore(x) = -1 Then Exit For
ActiveCell.FormulaR1C1 = intStore(x)
ActiveCell.Cells(2, 1).Select
Next
' The 6th For End
' Debug in Debug.Print to see what step the code is in
' In case of a loop or in case of too long execution, you can interrupt the execution
' Debug.Print "Z: " & Z & vbCrLf
' Debug.Print x - 1 & " numbers" & vbCrLf
'
Next
' The 1st For End
End Sub
Function AllZerosAtEnd(intArray() As Integer) As Integer
Dim intNumZeros As Integer
Dim intTempArray(1 To 7) As Integer
Dim count As Integer
Dim i As Byte
Dim position As Byte
Dim intTemp As Integer
intNumZeros = 0
For i = 1 To 7
If intArray(i) = 0 Then intNumZeros = intNumZeros + 1
Next
position = 1
If intNumZeros <> 0 Then
For i = 1 To 7
If intArray(i) <> 0 Then
intTempArray(position) = intArray(i)
position = position + 1
End If
Next
For i = 1 To 7
intArray(i) = intTempArray(i)
Next
End If
AllZerosAtEnd = 7 - intNumZeros
End Function
已编辑答案
我明白你的意图了。请参阅以下新代码。
Sub BuidChains()
Dim vData As Variant
Dim Ws As Worksheet, rstWs As Worksheet
Dim a As Variant
Dim n As Integer, sNum As Integer
Dim Dic As Object
Dim v As Variant
Set Ws = Sheets("For_Macros")
Set rstWs = Sheets("Sheet3") 'Sheets.Add 'set the result sheet
vData = Ws.Range("B1:H86").Value
rstWs.UsedRange.Clear
For n = 1 To 86
'find first value not empty
For j = 1 To 7
If vData(n, j) <> "" Then
sNum = vData(n, j)
Exit For
End If
Next j
Set Dic = CreateObject("Scripting.Dictionary")
a = ChainArray(n, vData, Dic, sNum)
Debug.Print n & " : " & Join(a, ",")
'Record it on the sheet.
With rstWs
.Cells(1, n) = UBound(a) + 1
.Cells(3, n) = n
.Cells(4, n).Resize(UBound(a)) = Application.Transpose(a)
.Range("cj1") = "Max"
.Range("cj2") = "Min"
.Range("cM1").Resize(2).Value = "Start number"
.Range("cK1") = WorksheetFunction.Max(.Range("a1").Resize(1, 86))
.Range("cK2") = WorksheetFunction.Min(.Range("a1").Resize(1, 86))
.Range("cn1") = WorksheetFunction.HLookup(.Range("ck1"), .Range("a1").Resize(3, 86), 3, 0)
.Range("cn2") = WorksheetFunction.HLookup(.Range("ck2"), .Range("a1").Resize(3, 86), 3, 0)
End With
Next n
End Sub
Static Function ChainArray(k As Integer, v As Variant, Dic As Object, sNum As Integer) As Variant
Dim vR() As Variant
Dim i As Integer, j As Integer
Dim Ws As Worksheet
Dim n As Integer, cnt As Integer
If n > 100 Then Exit Function
If n = 0 Then Dic.Add k, k
cnt = cnt + 1
If cnt > 100 Then
cnt = 0
n = 0
Exit Function
End If
For j = 1 To 7
If v(k, j) <> "" Then
If Not Dic.Exists(v(k, j)) Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = v(k, j)
i = v(k, j)
Dic.Add i, i
Exit For
End If
End If
Next j
DoEvents
ChainArray i, v, Dic, sNum
ChainArray = vR
End Function
结果图片
结果调试
我的结果与您展示的有点不同。
1 : 74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
2 : 64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,61,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,15,5
3 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
4 : 83,24,37,11,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
5 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,29,43,74,46,19,27,28,32,7
6 : 42,81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,68,16,20,2,64,79,41,47,62,7
7 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,32,51,53,14,83,4,47,62,2,64,79,41,59,70,61,58,68,23,80,17,6,42,81,73,38,9,67,13,40,5,37,11,15,71,33,20,16,50,1
8 : 54,77,84,76,10,18,57,34,75,35,49,3,65,44,12,31,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
9 : 74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
10 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
11 : 83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
12 : 31,84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
13 : 40,10,18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
14 : 83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,11,15,37,48,33,73,38,9,74,46,19,29,43,25,26,69,27,28,32,7
15 : 37,11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
16 : 20,2,64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,60,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
17 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
18 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,46,19,29,43,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,23,80,17,68,16,20,61,58,15,5
19 : 46,18,57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
20 : 2,64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,50,1,74,46,19,29,43,25,26,69,27,28,32,7,63,66,56,42,81,78,80,17,6
21 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,72,68,23,80,17,6,42,81,79,41,47,62,2,64,59,70,61,58,15,37,11,83,4,14,82,38,9,67,13,40,5
22 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,46,19,29,43,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,23,80,17,68,16,20,61,58,15,5
23 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
24 : 37,11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
25 : 26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
26 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
27 : 74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
28 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,70,61,58,68,23,80,17,6,42,81,79,41,47,62,2,64,59,71,33,73,38,9,67,13,40,5,37,11,83,4,15
29 : 43,74,46,19,27,28,32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
30 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
31 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
32 : 7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,21,36,40,23,80,17,6,42,81,79,41,47,62,2,64,59,70,61,58,68,16,20
33 : 86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
34 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,52,22,1,74,46,19,29,43,25,26,69,27,28,32,7,63,66,56,42,81,78,80,17,6
35 : 49,3,65,44,8,54,77,84,76,10,18,57,34,75,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,78,7
36 : 43,74,46,19,29,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
37 : 11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
38 : 9,74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
39 : 15,37,11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
40 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
41 : 79,64,2
42 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6
43 : 74,46,19,29,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
44 : 8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
45 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
46 : 19,29,43,74,69,27,28,32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
47 : 62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,4,83,24,37,11,15,5
48 : 47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,4,83,24,37,11,15,5
49 : 3,65,44,8,54,77,84,76,10,18,57,34,75,35,32,7,63,66,56,74,46,19,29,43,25,26,69,27,28,21,36,40,23,80,17,6,42,81,78,51,53,14,83,4,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,37,11,39,48,33,73,38,9,67,13,24
50 : 16,20,2,64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,60,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
51 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,32,7
52 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,46,19,29,43,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,23,80,17,68,16,20,61,58,15,5
53 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,47,62,7,63,66,56,74,46,19,29,43,25,26,69,27,28,32,51,45,38,9,67,13,40,23,80,17,6,42,81,78,33,86,12,31,85,72,68
54 : 77,84,76,10,18,57,34,75,35,49,3,65,44,8,31,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
55 : 23,80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
56 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,73,38,9,74,46,19,29,43,25,26,69,27,28,32,7
57 : 34,75,35,49,3,65,44,8,54,77,84,76,10,18,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
58 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,67,64,79,41,47,62,2
59 : 79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,46,19,29,43,74,69,27,28,32,7,63,66,56,42,81,78,80,17,6
60 : 36,43,74,46,19,29,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
61 : 58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,67,64,79,41,47,62,2
62 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,47,67,13,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,15,5
63 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,32,7
64 : 79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2
65 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
66 : 56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,7
67 : 64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2
68 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,15,37,11,83,4,47,62,2,64,79,41,86,78,66,56,63
69 : 27,74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
70 : 61,58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,67,64,79,41,47,62,2
71 : 33,86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
72 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,15,37,11,83,4,47,62,2,64,79,41,86,78,66,56,63
73 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,81,79,41,47,62,2,64,46,19,29,43,74,69,27,28,32,7
74 : 46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
75 : 35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,47,62,7,63,66,56,74,46,19,29,43,25,26,69,27,28,32,51,53,14,83,4,15,37,11,31,85,72,68,23,80,17,6,42,81,78,33,86,40,5
76 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,12,31,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
77 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,20,2,64,79,41,47,62,7,63,66,56,74,46,19,29,43,25,26,69,27,28,32,51,53,14,83,4,15,37,11,31,85,72,68,23,80,17,6,42,81,78,33,86,40,5
78 : 66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,81,79,41,47,62,2,64,46,19,29,43,74,69,27,28,32,7
79 : 41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,46,19,29,43,74,69,27,28,32,7,63,66,56,42,81,78,80,17,6
80 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
81 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,82,64,79,41,47,62,2
82 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,64,79,41,47,62,2
83 : 4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,11,15,37,14,81,69,27,74,46,19,29,43,25,26,22,1
84 : 76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
85 : 72,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,15,37,11,83,4,47,62,2,64,79,41,86,78,66,56,63
86 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
不知道你的意图是否正确。试一试
Sub test()
Dim vData As Variant
Dim Ws As Worksheet, rstWs As Worksheet
Dim a() As Variant
Dim n As Integer
Dim Dic As Object
Dim v As Variant
Set Dic = CreateObject("Scripting.Dictionary")
Set Ws = Sheets("For_Macros")
Set rstWs = Sheets.Add 'set the result sheet
vData = Ws.Range("B1:H86").Value
For n = 1 To 86
a = myArray(n, vData, Dic)
Debug.Print n & " : " & Join(a, ",")
With rstWs
.Range("a" & n) = n
.Range("b" & n).Resize(1, UBound(a)) = a
End With
Next n
End Sub
Static Function myArray(k As Integer, v As Variant, Dic As Object) As Variant
Dim vR() As Variant
Dim i As Integer, j As Integer
Dim Ws As Worksheet
Dim n As Integer
If n > 83 Then Exit Function
For j = 1 To 7
If v(k, j) <> "" Then
If Dic.Exists(v(k, j)) Then
n = 0
Set Dic = CreateObject("Scripting.Dictionary")
Exit Function
Else
Dic.Add v(k, j), v(k, j)
End If
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = v(k, j)
i = v(k, j)
Exit For
End If
Next j
DoEvents
myArray i, v, Dic
myArray = vR
End Function
调试结果
1 : 74,46,19
2 : 64,79,41
3 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
4 : 83,4
5 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
6 : 42,81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
7 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
8 : 54,77,84,76,10,18,57,34,75,35,49,3,65,44,8
9 : 74,46,19
10 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10
11 : 83,4
12 : 31,84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
13 : 40,10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
14 : 83,4
15 : 37,11,83,4
16 : 20,2,64,79,41
17 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
18 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,18
19 : 46,19
20 : 2,64,79,41
21 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
22 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10
23 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
24 : 37,11,83,4
25 : 26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18
26 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,18
27 : 74,46,19
28 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
29 : 43,74,46,19
30 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
31 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
32 : 7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
33 : 86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
34 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
35 : 49,3,65,44,8,54,77,84,76,10,18,57,34,75,35
36 : 43,74,46,19
37 : 11,83,4
38 : 9,74,46,19
39 : 15,37,11,83,4
40 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
41 : 79,41
42 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
43 : 74,46,19
44 : 8,54,77,84,76,10,18,57,34,75,35,49,3,65,44
45 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
46 : 19,46
47 : 62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
48 : 47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
49 : 3,65,44,8,54,77,84,76,10,18,57,34,75,35,49
50 : 16,20,2,64,79,41
51 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
52 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10
53 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
54 : 77,84,76,10,18,57,34,75,35,49,3,65,44,8,54
55 : 23,80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
56 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
57 : 34,75,35,49,3,65,44,8,54,77,84,76,10,18,57
58 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
59 : 79,41
60 : 36,43,74,46,19
61 : 58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
62 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
63 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
64 : 79,41
65 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
66 : 56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
67 : 64,79,41
68 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
69 : 27,74,46,19
70 : 61,58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
71 : 33,86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
72 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
73 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
74 : 46,19
75 : 35,49,3,65,44,8,54,77,84,76,10,18,57,34,75
76 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
77 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
78 : 66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
79 : 41,79
80 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
81 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
82 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
83 : 4,83
84 : 76,10,18,57,34,75,35,49,3,65,44,8,54,77,84
85 : 72,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
86 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
有一个 table 有数字。看 Attachment
第一列作为索引。它的编号为 0。 它决定跳转到哪一行。 行中输入了一个数字 select。 根据这个数字，转到有这个数字的行。 我们 select 来自新行的数字等等。
限制。 数字在过渡期间不重复 return到初始号只能在过渡号上等于table中的行数。
有必要根据 table 中的数字构建最长可能的转换链。理想情况下，循环，即当初始数等于最终数时，过渡次数等于行数。
例如，让我们从数字 1 开始。 第一行包含唯一的数字 - 74。转到第 74 行。 在第 74 行 select 第一列中的数字（零列是行编号索引）。第 74 行第一列没有任何内容，因此我们在后面的列中进一步查看。在第 2 列中有一个数字 46。转到第 46 行。 第 46 行第一列有一个数字 19。转到第 19 行。 等等
如果不可能select这样的数字不重复，那就输出原来是文件的序列。 然后寻找其他方法来实现最长的转换链。
如果代码可以返回一、二、...n 步并选择不同的路径，那就太好了。例如，在第一遍中，代码选择了行中的第一个数字并遇到了死胡同，然后返回并 selects 第二或第三个并再次重复。 我对如何在代码中执行此操作知之甚少。
充其量，我希望代码建议如何修复输入 table 以获得完整的序列。也就是说，代码会建议在哪个单元格中更改数字以循环序列。
我手动检查了这个 table 并发现至少有两个序列在第 86 步循环（现在 table 中有 86 行），但附加代码给出的最大值为 73步骤。
我在 Excel 中写了 VBA 代码。你可以在下面看到它。
完整 xls Drive.Google。
请告诉我如何解决这个问题。 如果这样的问题不能用VBA解决，请给我一个建议，我应该使用哪种编程语言。
Function IsUnique(ByRef intArr() As Integer, intNum As Integer) As Boolean
Dim intPart() As Integer
ReDim intPart(1 To UBound(intArr)) As Integer
For i = 1 To UBound(intArr)
intPart(i) = intArr(i)
Next
QuickSortInteger intPart
If (BinarySearchInteger(intPart, intNum) = -1) And (intNum <> 0) Then
IsUnique = True
Else
IsUnique = False
End If
End Function
Sub Main()
Dim varIData() As Variant
Dim intTemp(1 To 7) As Integer
Dim intTempWOZeros() As Integer
Dim intTempDSC(1 To 7) As Integer
Dim intTempCount As Integer
Dim intStore() As Integer
Dim intIData(1 To 86, 1 To 7) As Integer
Dim intBegin As Integer
Dim intCurr As Integer
Dim str As String
Sheets("For_Macros").Select
' Reads the given Excel table in a two-dimensional array
varIData = Range("B1:H86").Value
' In the cycle, the data from the Variant-array tranfer to Integer-array, empty values is replaced by zeros
For i = 1 To 86
For j = 1 To 7
If varIData(i, j) = "" Then
intIData(i, j) = 0
Else
intIData(i, j) = CInt(varIData(i, j))
End If
Next
Next
' Searching for other paths of the solution
' Reverse input array. The fisrt element became the last and the last - the first.
' For i = 1 To 86
' For j = 1 To 7
' intTemp(8 - j) = intIData(i, j)
' Next
'
' For j = 1 To 7
' intIData(i, j) = intTemp(j)
' Next
' Next
' Sort rows entire values - ascending
' I tried to change an order in numbers in each row
' For i = 1 To 86
' For j = 1 To 7
' intTemp(j) = intIData(i, j)
' Next
'
' QuickSortInteger intTemp()
'
' For j = 1 To 7
' intIData(i, j) = intTemp(j)
' Next
' Next
' Sort rows entire values - descending
' I tried to change an order in numbers in each row
' For i = 1 To 86
' For j = 1 To 7
' intTemp(j) = intIData(i, j)
' Next
'
' QuickSortInteger intTemp()
'
' For j = 1 To 7
' intTempDSC(8 - j) = intTemp(j)
' Next
'
' For j = 1 To 7
' intIData(i, j) = intTempDSC(j)
' Next
' Next
' The 1st For
For Z = 1 To 86 ' Top level.
' 'For ... next' for each start number
' At the first iteration we take the number 1 and begin
' form the 1st row, to build a sequence much posible as can
' At the 2nd iteratoin we take number two as the first number and begin
' form the 1st row, to build a sequence much posible as can
' We try go through the array every time starting with new row
' and do until we can add in a sequence new unique number
i = Z
ReDim Preserve intStore(1) ' Array in which we collect all number in a sequence
intStore(1) = i ' Array initialization with value = i, just like starting with the i-th line,
' and at i-th number we can not returm until amount of collecting number
' will be less than an amount of rows in intIData-array
' If intIData-array has got 100 row, then we can return
' at the begining row (wherever it be the 1st, the 49th or the 93th) at 100th iteration only
m = 0
' The 2nd For
For k = 1 To 85
ReDim Preserve intStore(k + 1)
intStore(k + 1) = -1
' We search any non-zero value
' We take this number from row selected from intIData
m = 1
intTempCount = 0
' Count amount of zeros
' Discard zeros
' Copy one row form 2d-array to 1d-array. 1d-array consists 1 row from intIData data-array
' The 3rd For
For count = 1 To 7
intTemp(count) = intIData(i, count)
Next
' The 3rd For End
' Count amount of zeros. We arrange the array so that it initially contains non-zero values
intTempCount = AllZerosAtEnd(intTemp())
ReDim intTempWOZeros(1 To intTempCount)
' Transferring to an array without zeros
' The 4th For
For count = 1 To intTempCount
intTempWOZeros(count) = intTemp(count)
Next
' The 4th For End
intCurr = intTempWOZeros(1)
m = 1
Povtor:
If IsUnique(intStore, intCurr) Then ' We check the uniqueness of the selected number if unique put it in the output array intStore
intStore(k + 1) = intCurr
i = intCurr ' and assign the variable i the value of this unique number, the next iteration of the loop will already analyze the string with this number
Else
If m <= intTempCount Then ' if there are still numbers in the intTempWOZeros row-array, then view other columns
' The 5th For
For j = m To intTempCount ' select the next value from the array, increase m by 1 and exit the loop back to check the uniqueness
intCurr = intTempWOZeros(j)
m = j + 1
GoTo Povtor
Next ' The 5th For End
Else
GoTo Metka
End If
End If
Next
' The 2nd For End
Metka: ' To fill Excel sheet Search results, sheet created manually
Sheets("PathOrder").Select
Range("A1").Select
ActiveCell.Cells(3, Z).Select ' Applied from the 3rd line,
' in the first line is for an amount of found numbers
' the 2nd line is the blank
' The 6th For
For x = 1 To UBound(intStore)
If intStore(x) = -1 Then Exit For
ActiveCell.FormulaR1C1 = intStore(x)
ActiveCell.Cells(2, 1).Select
Next
' The 6th For End
' Debug in Debug.Print to see what step the code is in
' In case of a loop or in case of too long execution, you can interrupt the execution
' Debug.Print "Z: " & Z & vbCrLf
' Debug.Print x - 1 & " numbers" & vbCrLf
'
Next
' The 1st For End
End Sub
Function AllZerosAtEnd(intArray() As Integer) As Integer
Dim intNumZeros As Integer
Dim intTempArray(1 To 7) As Integer
Dim count As Integer
Dim i As Byte
Dim position As Byte
Dim intTemp As Integer
intNumZeros = 0
For i = 1 To 7
If intArray(i) = 0 Then intNumZeros = intNumZeros + 1
Next
position = 1
If intNumZeros <> 0 Then
For i = 1 To 7
If intArray(i) <> 0 Then
intTempArray(position) = intArray(i)
position = position + 1
End If
Next
For i = 1 To 7
intArray(i) = intTempArray(i)
Next
End If
AllZerosAtEnd = 7 - intNumZeros
End Function
已编辑答案
我明白你的意图了。请参阅以下新代码。
Sub BuidChains()
Dim vData As Variant
Dim Ws As Worksheet, rstWs As Worksheet
Dim a As Variant
Dim n As Integer, sNum As Integer
Dim Dic As Object
Dim v As Variant
Set Ws = Sheets("For_Macros")
Set rstWs = Sheets("Sheet3") 'Sheets.Add 'set the result sheet
vData = Ws.Range("B1:H86").Value
rstWs.UsedRange.Clear
For n = 1 To 86
'find first value not empty
For j = 1 To 7
If vData(n, j) <> "" Then
sNum = vData(n, j)
Exit For
End If
Next j
Set Dic = CreateObject("Scripting.Dictionary")
a = ChainArray(n, vData, Dic, sNum)
Debug.Print n & " : " & Join(a, ",")
'Record it on the sheet.
With rstWs
.Cells(1, n) = UBound(a) + 1
.Cells(3, n) = n
.Cells(4, n).Resize(UBound(a)) = Application.Transpose(a)
.Range("cj1") = "Max"
.Range("cj2") = "Min"
.Range("cM1").Resize(2).Value = "Start number"
.Range("cK1") = WorksheetFunction.Max(.Range("a1").Resize(1, 86))
.Range("cK2") = WorksheetFunction.Min(.Range("a1").Resize(1, 86))
.Range("cn1") = WorksheetFunction.HLookup(.Range("ck1"), .Range("a1").Resize(3, 86), 3, 0)
.Range("cn2") = WorksheetFunction.HLookup(.Range("ck2"), .Range("a1").Resize(3, 86), 3, 0)
End With
Next n
End Sub
Static Function ChainArray(k As Integer, v As Variant, Dic As Object, sNum As Integer) As Variant
Dim vR() As Variant
Dim i As Integer, j As Integer
Dim Ws As Worksheet
Dim n As Integer, cnt As Integer
If n > 100 Then Exit Function
If n = 0 Then Dic.Add k, k
cnt = cnt + 1
If cnt > 100 Then
cnt = 0
n = 0
Exit Function
End If
For j = 1 To 7
If v(k, j) <> "" Then
If Not Dic.Exists(v(k, j)) Then
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = v(k, j)
i = v(k, j)
Dic.Add i, i
Exit For
End If
End If
Next j
DoEvents
ChainArray i, v, Dic, sNum
ChainArray = vR
End Function
结果图片
结果调试
我的结果与您展示的有点不同。
1 : 74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
2 : 64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,61,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,15,5
3 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
4 : 83,24,37,11,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
5 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,29,43,74,46,19,27,28,32,7
6 : 42,81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,68,16,20,2,64,79,41,47,62,7
7 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,32,51,53,14,83,4,47,62,2,64,79,41,59,70,61,58,68,23,80,17,6,42,81,73,38,9,67,13,40,5,37,11,15,71,33,20,16,50,1
8 : 54,77,84,76,10,18,57,34,75,35,49,3,65,44,12,31,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
9 : 74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
10 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
11 : 83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
12 : 31,84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
13 : 40,10,18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
14 : 83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,11,15,37,48,33,73,38,9,74,46,19,29,43,25,26,69,27,28,32,7
15 : 37,11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
16 : 20,2,64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,60,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
17 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
18 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,46,19,29,43,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,23,80,17,68,16,20,61,58,15,5
19 : 46,18,57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
20 : 2,64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,50,1,74,46,19,29,43,25,26,69,27,28,32,7,63,66,56,42,81,78,80,17,6
21 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,72,68,23,80,17,6,42,81,79,41,47,62,2,64,59,70,61,58,15,37,11,83,4,14,82,38,9,67,13,40,5
22 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,46,19,29,43,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,23,80,17,68,16,20,61,58,15,5
23 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
24 : 37,11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
25 : 26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
26 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
27 : 74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
28 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,70,61,58,68,23,80,17,6,42,81,79,41,47,62,2,64,59,71,33,73,38,9,67,13,40,5,37,11,83,4,15
29 : 43,74,46,19,27,28,32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
30 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
31 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
32 : 7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,21,36,40,23,80,17,6,42,81,79,41,47,62,2,64,59,70,61,58,68,16,20
33 : 86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
34 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,52,22,1,74,46,19,29,43,25,26,69,27,28,32,7,63,66,56,42,81,78,80,17,6
35 : 49,3,65,44,8,54,77,84,76,10,18,57,34,75,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,78,7
36 : 43,74,46,19,29,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
37 : 11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
38 : 9,74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
39 : 15,37,11,83,4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63
40 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
41 : 79,64,2
42 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6
43 : 74,46,19,29,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
44 : 8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
45 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76,26,69,27,74,46,19,29,43,25,58,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
46 : 19,29,43,74,69,27,28,32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
47 : 62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,4,83,24,37,11,15,5
48 : 47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,4,83,24,37,11,15,5
49 : 3,65,44,8,54,77,84,76,10,18,57,34,75,35,32,7,63,66,56,74,46,19,29,43,25,26,69,27,28,21,36,40,23,80,17,6,42,81,78,51,53,14,83,4,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,37,11,39,48,33,73,38,9,67,13,24
50 : 16,20,2,64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,60,36,43,74,46,19,29,7,63,66,56,42,81,78,80,17,6
51 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,32,7
52 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10,25,26,69,27,74,46,19,29,43,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,23,80,17,68,16,20,61,58,15,5
53 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,47,62,7,63,66,56,74,46,19,29,43,25,26,69,27,28,32,51,45,38,9,67,13,40,23,80,17,6,42,81,78,33,86,12,31,85,72,68
54 : 77,84,76,10,18,57,34,75,35,49,3,65,44,8,31,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
55 : 23,80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
56 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,73,38,9,74,46,19,29,43,25,26,69,27,28,32,7
57 : 34,75,35,49,3,65,44,8,54,77,84,76,10,18,26,69,27,74,46,19,29,43,25,45,38,9,67,64,79,41,47,62,2
58 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,67,64,79,41,47,62,2
59 : 79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,46,19,29,43,74,69,27,28,32,7,63,66,56,42,81,78,80,17,6
60 : 36,43,74,46,19,29,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,42,81,79,41,47,62,2,64,59,70,61,58,68,23,80,17,6
61 : 58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,67,64,79,41,47,62,2
62 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,47,67,13,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,15,5
63 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,74,46,19,29,43,25,26,69,27,28,32,7
64 : 79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2
65 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
66 : 56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,7
67 : 64,79,41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2
68 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,15,37,11,83,4,47,62,2,64,79,41,86,78,66,56,63
69 : 27,74,46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
70 : 61,58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,67,64,79,41,47,62,2
71 : 33,86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
72 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,15,37,11,83,4,47,62,2,64,79,41,86,78,66,56,63
73 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,81,79,41,47,62,2,64,46,19,29,43,74,69,27,28,32,7
74 : 46,19,29,43,25,26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18,36,40,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,12,31,85,72,68,16,20,61,58,15,5
75 : 35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,47,62,7,63,66,56,74,46,19,29,43,25,26,69,27,28,32,51,53,14,83,4,15,37,11,31,85,72,68,23,80,17,6,42,81,78,33,86,40,5
76 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,12,31,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
77 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,20,2,64,79,41,47,62,7,63,66,56,74,46,19,29,43,25,26,69,27,28,32,51,53,14,83,4,15,37,11,31,85,72,68,23,80,17,6,42,81,78,33,86,40,5
78 : 66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,81,79,41,47,62,2,64,46,19,29,43,74,69,27,28,32,7
79 : 41,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,46,19,29,43,74,69,27,28,32,7,63,66,56,42,81,78,80,17,6
80 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,59,74,46,19,29,43,25,26,69,27,28,32,7
81 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,82,64,79,41,47,62,2
82 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3,86,40,23,80,17,6,42,64,79,41,47,62,2
83 : 4,47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34,16,20,2,64,79,41,86,78,66,56,63,11,15,37,14,81,69,27,74,46,19,29,43,25,26,22,1
84 : 76,10,18,57,34,75,35,49,3,65,44,8,54,77,85,72,68,23,80,17,6,42,81,78,66,56,63,4,83,24,37,11,47,62,2,64,79,41,86,40,5
85 : 72,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65,58,15,37,11,83,4,47,62,2,64,79,41,86,78,66,56,63
86 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
不知道你的意图是否正确。试一试
Sub test()
Dim vData As Variant
Dim Ws As Worksheet, rstWs As Worksheet
Dim a() As Variant
Dim n As Integer
Dim Dic As Object
Dim v As Variant
Set Dic = CreateObject("Scripting.Dictionary")
Set Ws = Sheets("For_Macros")
Set rstWs = Sheets.Add 'set the result sheet
vData = Ws.Range("B1:H86").Value
For n = 1 To 86
a = myArray(n, vData, Dic)
Debug.Print n & " : " & Join(a, ",")
With rstWs
.Range("a" & n) = n
.Range("b" & n).Resize(1, UBound(a)) = a
End With
Next n
End Sub
Static Function myArray(k As Integer, v As Variant, Dic As Object) As Variant
Dim vR() As Variant
Dim i As Integer, j As Integer
Dim Ws As Worksheet
Dim n As Integer
If n > 83 Then Exit Function
For j = 1 To 7
If v(k, j) <> "" Then
If Dic.Exists(v(k, j)) Then
n = 0
Set Dic = CreateObject("Scripting.Dictionary")
Exit Function
Else
Dic.Add v(k, j), v(k, j)
End If
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = v(k, j)
i = v(k, j)
Exit For
End If
Next j
DoEvents
myArray i, v, Dic
myArray = vR
End Function
调试结果
1 : 74,46,19
2 : 64,79,41
3 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
4 : 83,4
5 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
6 : 42,81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
7 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
8 : 54,77,84,76,10,18,57,34,75,35,49,3,65,44,8
9 : 74,46,19
10 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10
11 : 83,4
12 : 31,84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
13 : 40,10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
14 : 83,4
15 : 37,11,83,4
16 : 20,2,64,79,41
17 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
18 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,18
19 : 46,19
20 : 2,64,79,41
21 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
22 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10
23 : 80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
24 : 37,11,83,4
25 : 26,57,34,75,35,49,3,65,44,8,54,77,84,76,10,18
26 : 57,34,75,35,49,3,65,44,8,54,77,84,76,10,18
27 : 74,46,19
28 : 32,7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
29 : 43,74,46,19
30 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
31 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
32 : 7,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
33 : 86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
34 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
35 : 49,3,65,44,8,54,77,84,76,10,18,57,34,75,35
36 : 43,74,46,19
37 : 11,83,4
38 : 9,74,46,19
39 : 15,37,11,83,4
40 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
41 : 79,41
42 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
43 : 74,46,19
44 : 8,54,77,84,76,10,18,57,34,75,35,49,3,65,44
45 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
46 : 19,46
47 : 62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
48 : 47,62,75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
49 : 3,65,44,8,54,77,84,76,10,18,57,34,75,35,49
50 : 16,20,2,64,79,41
51 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
52 : 18,57,34,75,35,49,3,65,44,8,54,77,84,76,10
53 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
54 : 77,84,76,10,18,57,34,75,35,49,3,65,44,8,54
55 : 23,80,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
56 : 63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
57 : 34,75,35,49,3,65,44,8,54,77,84,76,10,18,57
58 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
59 : 79,41
60 : 36,43,74,46,19
61 : 58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
62 : 75,35,49,3,65,44,8,54,77,84,76,10,18,57,34
63 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
64 : 79,41
65 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
66 : 56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
67 : 64,79,41
68 : 44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
69 : 27,74,46,19
70 : 61,58,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
71 : 33,86,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
72 : 68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
73 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
74 : 46,19
75 : 35,49,3,65,44,8,54,77,84,76,10,18,57,34,75
76 : 10,18,57,34,75,35,49,3,65,44,8,54,77,84,76
77 : 84,76,10,18,57,34,75,35,49,3,65,44,8,54,77
78 : 66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
79 : 41,79
80 : 65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
81 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
82 : 81,78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3
83 : 4,83
84 : 76,10,18,57,34,75,35,49,3,65,44,8,54,77,84
85 : 72,68,44,8,54,77,84,76,10,18,57,34,75,35,49,3,65
86 : 78,66,56,63,65,44,8,54,77,84,76,10,18,57,34,75,35,49,3