将单元格地址添加到 VBA 中的动态数组

Question

我有一个脚本，其中循环遍历 9x9 数组，如果单元格包含 0，它将更改数字，使数字在行、列和其中的 3x3 正方形中是唯一的。每次找到并更改一个这样的单元格时，我想将该单元格位置添加到一个数组中，这样如果替换 0 的数字不是最优的，我可以轻松地返回到那个被更改的单元格并且尝试一个新号码。我该怎么做？

下面是我到目前为止编写的代码，我用三个撇号 (''') 表示我的“伪代码” 这进一步解释了我想要它做什么。

Check Function根据我提到的条件（Sudoku Rules）判断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

Answer 1

对于递归，您可以从拼图中的第一个空单元格开始。对于每个可能的值，将下一个空闲单元格传递给 child 以检查解决方案。该过程一直持续到找到解决方案（假设拼图有效）。

主要的 Solve 函数必须 return True 或 False，以便 parent 知道是否已找到解决方案。

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

将单元格地址添加到 VBA 中的动态数组

Add cell address to dynamic array in VBA

excel

recursion

vba

loops

sudoku