如何解决将单元格地址添加到VBA中的动态数组
我有一个脚本,其中我遍历9x9数组,如果一个单元格包含0,它将更改数字,以使该数字在行,列和其中的3x3正方形内是唯一的。每次找到并更改一个这样的单元格时,我想将该单元格位置添加到数组中,这样如果替换0的数字不是最佳值,我可以轻松地返回到已更改的单元格并尝试一个新号码。我该怎么做?
下面是我到目前为止编写的代码,我用三个撇号(''')表示我的“伪代码” 进一步说明了我想要它做什么。
检查功能根据我提到的条件(数独规则)确定是否可以在当前单元格中放置1到9之间的数字。
它处理递归,所以让我知道是否需要更清晰地解释。
Sub Solve()
Dim x As Integer,y As Integer,row As Integer,col As Integer,rw As Integer,cl As Integer,a As Worksheet,puzzle As Range,n As Integer,num As Integer
Dim startcol As Integer,startrow As Integer,check1 As Boolean,check2 As Boolean,check3 As Boolean,r As Integer,c As Integer,x1 As Double,y1 As Double,z As Boolean
Dim fillednums(1 To 9,1 To 9) As String
Set a = ThisWorkbook.Worksheets("Puzzle")
Set puzzle = a.Range(Cells(4,4),Cells(12,12))
startcol = 4
startrow = 4
For row = startrow To startrow + 8
For col = startcol To startcol + 8
If a.Cells(row,col).Value = 0 Then
For num = 1 To 9
If Check(col,row,num) = True Then
a.Cells(row,col).Value = num
'''Add cell address to array
Call Solve
ElseIf num = 9 And a.Cells(row,col).Value = 0 Then
'''Go back one index of the array (fillednums) and use check() function for numbers greater than the one in the cell and up to 9
'''If that still doesnt work,go back to cell before this one that was changed and check again (recursively)
'''Call Solve() again to try new number
'a.Cells(row,col).Value = 0
End If
Next num
End If
Next col
Next row
End Sub
解决方法
对于递归,您可以从拼图中的第一个空白单元格开始。对于每个可能的值,将下一个空闲单元格传递给孩子以检查解决方案。这个过程一直持续到找到解决方案为止(假设有有效的谜题)。
主要Solve函数必须返回True或False,以便父级知道是否已找到解决方案。
Function GetNextCell(cc) ' get next free cell in puzzle
GetNextCell = Cells(cc.Row,cc.Column+1) ' move next column
If (GetNextCell.Column = 13) Then ' go to next row
GetNextCell = Cells(cc.Row+1,4)
End If
If GetNextCell.Row = 13 Then ' off the grid
GetNextCell = Nothing ' no more cells
End If
If GetNextCell <> Nothing And GetNextCell.Value <> "" Then
GetNextCell GetNextCell(GetNextCell) ' skip filled cells
End If
Function Solve(cc) as Boolean
' we only care about our single cell
For num = 1 to 9 ' all possible values for this cell
cc.Value = num
If Check(cc.column,cc.row,num) Then ' so far so good
NextCell = GetNextCell(cc) ' get next cell for child to process
if NextCell = Nothing Then ' no more cells and current values work
Solve = True ' puzzle solved
Exit Function
Else ' call child with next cell
If Solve(NextCell) Then ' did child solve puzzle ?
Solve = True ' puzzle solved
Exit Function
End If
' Child could not find solution based on current values
End If
End If
Next
cc.Value = "" ' No solution found at this point,must revert back to parent to try next value
Solve = False ' no solution found
End Function
Solve(GetNextCell(Cells(4,3))) ' first empty cell in block,must return true