excel - 同一单元格中 1 到 9 的所有可能组合，不重复

Question

作为提高我对 VBA 理解的一种方法，我正在尝试构建一个交叉求和求解器。对于那些不知道下面的人来说，是一个交叉总和。每个空白单元格可以包含一个数字 1 - 9，但该数字只能在网格中出现一次，并且所有总和必须一致。

我有一些带有嵌套 for 和 if 语句的代码，它们确实在单元格中放入了所有可能的变化，但它需要很长时间，而且我确信这是一种非常低效的方法。

Sub Test()
 Dim StartTime As Double
 Dim SecondsElapsed As Double

 StartTime = Timer

 Dim wb As Workbook
 Dim ws As Worksheet

 Set wb = ThisWorkbook
 Set ws = wb.Worksheets("Sheet1")

 Application.ScreenUpdating = False

 Dim i, j, k, l, m, n, o, p, q As Integer

 For i = 1 To 9
  ws.Range("A1").Value = i

  For j = 1 To 9
   If j <> ws.Range("A1").Value Then
    ws.Range("C1").Value = j
   End If

   For k = 1 To 9
    If k <> ws.Range("A1").Value Then
     If k <> ws.Range("C1").Value Then
      ws.Range("E1").Value = k
     End If
    End If

    For l = 1 To 9
     If l <> ws.Range("A1").Value Then
      If l <> ws.Range("C1").Value Then
       If l <> ws.Range("E1").Value Then
        ws.Range("A3").Value = l
       End If
      End If
     End If

     For m = 1 To 9
      If m <> ws.Range("A1").Value Then
       If m <> ws.Range("C1").Value Then
        If m <> ws.Range("E1").Value Then
         If m <> ws.Range("A3").Value Then
          ws.Range("B3").Value = m
         End If
        End If
       End If
      End If

      For n = 1 To 9
       If n <> ws.Range("A1").Value Then
        If n <> ws.Range("C1").Value Then
         If n <> ws.Range("E1").Value Then
          If n <> ws.Range("A3").Value Then
           If n <> ws.Range("C3").Value Then
            ws.Range("E3").Value = n
           End If
          End If
         End If
        End If
       End If

       For o = 1 To 9
        If o <> ws.Range("A1").Value Then
         If o <> ws.Range("C1").Value Then
          If o <> ws.Range("E1").Value Then
           If o <> ws.Range("A3").Value Then
            If o <> ws.Range("C3").Value Then
             If o <> ws.Range("E3").Value Then
              ws.Range("A5").Value = o
             End If
            End If
           End If
          End If
         End If
        End If

        For p = 1 To 9
         If p <> ws.Range("A1").Value Then
          If p <> ws.Range("C1").Value Then
           If p <> ws.Range("E1").Value Then
            If p <> ws.Range("A3").Value Then
             If p <> ws.Range("C3").Value Then
              If p <> ws.Range("E3").Value Then
               If p <> ws.Range("A3").Value Then
                ws.Range("C5").Value = p
               End If
              End If
             End If
            End If
           End If
          End If
         End If

         For q = 1 To 9
          If q <> ws.Range("A1").Value Then
           If q <> ws.Range("C1").Value Then
            If q <> ws.Range("E1").Value Then
             If q <> ws.Range("A3").Value Then
              If q <> ws.Range("C3").Value Then
               If q <> ws.Range("E3").Value Then
                If q <> ws.Range("A5").Value Then
                 If q <> ws.Range("C5").Value Then
                  ws.Range("E5").Value = q
                 End If
                End If
               End If
              End If
             End If
            End If
           End If
          End If
         Next q
        Next p
       Next o
      Next n
     Next m
    Next l
   Next k
  Next j
 Next i

 Application.ScreenUpdating = True

 SecondsElapsed = Round(Timer - StartTime, 2)

 MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

是否有更明智的方法来实现将数字放入单元格中？我已经有了评估部分来根据运算符和已经起作用的答案进行求和，因此一旦我完成此工作，我不会每次都将其放入单元格中，而只是传递给变量。我只是为了测试而将值放入单元格中。

非常感谢

Answer 1

您可以将数字放入数组中 - 使用数组比使用范围更快，并且您可以使用 IsError(Application.Match(Value,Array,0)) 来测试是否number Value 已在 Array 中的任何位置使用。

一旦找到“有效”的解决方案，您就可以停止循环(除非您想检查有多少个有效的解决方案) - 我可能会因此受到一些人的斥责和诽谤，但 GoTo 是一个快速、肮脏且简单的解决方案

除此之外，我将使用几个 CodeGolf使代码在视觉上更短的技巧，例如使用 Type Characters简化 Dim 语句或链式 Next 语句 - 并且在生成所有 9 个数字后，我不会检查输出是否仍然有效，而是会执行一次.

Sub CrossSumSolver()

    Dim StartTime As Double
    Dim SecondsElapsed As Double

    StartTime = Timer

    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim OutputArray(1 To 9) As Long, IsValid As Boolean, CheckLoop As Long
    Dim a&, b&, c&, d&, e&, f&, g&, h&, i& 'All "As Long"

    For a = 1 To 9
        OutputArray(1) = a
        For b = 1 To 9
            OutputArray(2) = b
            For c = 1 To 9
                OutputArray(3) = c
                For d = 1 To 9
                    OutputArray(4) = d
                    For e = 1 To 9
                        OutputArray(5) = e
                        For f = 1 To 9
                            OutputArray(6) = f
                            For g = 1 To 9
                                OutputArray(7) = g
                                For h = 1 To 9
                                    OutputArray(8) = h
                                    For i = 1 To 9
                                        OutputArray(9) = i
                                        'Array is populated - is it valid?
                                        IsValid = True
                                        'Are all 9 numbers used once?
                                        For CheckLoop = 1 To 9
                                            If IsError(Application.Match(CheckLoop, OutputArray, 0)) Then
                                                IsValid = False 'A number is missing!
                                                Exit For 'Only need to find 1 error
                                            End If
                                        Next CheckLoop
                                        If IsValid Then
                                            'Populate sheet
                                            ws.Range("A1").Value = OutputArray(1)
                                            ws.Range("C1").Value = OutputArray(2)
                                            ws.Range("E1").Value = OutputArray(3)
                                            ws.Range("A3").Value = OutputArray(4)
                                            ws.Range("C3").Value = OutputArray(5)
                                            ws.Range("E3").Value = OutputArray(6)
                                            ws.Range("A5").Value = OutputArray(7)
                                            ws.Range("C5").Value = OutputArray(8)
                                            ws.Range("E5").Value = OutputArray(9)
                                            'Calculate sheet
                                            ws.Calculate
                                            'Check if your output is correct
                                            If (False) Then GoTo QuickExit 'Replace (False) with your check!
                                        End If
    Next i, h, g, f, e, d, c, b, a 'No need for a Wall of "Next"

QuickExit:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    SecondsElapsed = Round(Timer - StartTime, 2)

    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

或者，您可以使用递归子例程(即调用自身的子例程)的弊端来依次循环数组中每个项目的数字。 (如果使用得当，功能强大，但如果使用不当，您的计算机最终会被锁定在永久循环中，并且 Excel/VBA 会占用越来越多的内存)

Option Explicit

Private ValueArray(1 To 9) As Long
Private wb As Workbook
Private ws As Worksheet

Public Sub ControlLoop()
    Dim StartTime As Double
    Dim SecondsElapsed As Double

    StartTime = Timer

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim OutermostLoop As Long

    For OutermostLoop = 1 To 9
        ClearArrayAbove 1
        RecursiveArrayLoop 1, OutermostLoop
    Next OutermostLoop

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    SecondsElapsed = Round(Timer - StartTime, 2)

    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

Private Sub ClearArrayAbove(ArrayItem As Long)
    If ArrayItem >= 9 Then Exit Sub 'Safety check
    Dim InnerLoop As Long

    For InnerLoop = ArrayItem To 9
        ValueArray(InnerLoop) = 0
    Next InnerLoop
End Sub

Private Sub RecursiveArrayLoop(ArrayItem As Long, NewValue As Long)
    Dim InnerLoop As Long

    'Number is not already in the array
    If IsError(Application.Match(NewValue, ValueArray, 0)) Then
        'Add number to array
        ValueArray(ArrayItem) = NewValue
        If ArrayItem < 9 Then
            'Go up a level, and loop again
            For InnerLoop = 1 To 9
                ClearArrayAbove ArrayItem
                RecursiveArrayLoop ArrayItem + 1, InnerLoop
            Next InnerLoop
        Else
            'All numbers filled!
            TestValidNumbers
        End If
    End If
End Sub

Private Sub TestValidNumbers()
    'Populate sheet
    ws.Range("A1").Value = ValueArray(1)
    ws.Range("C1").Value = ValueArray(2)
    ws.Range("E1").Value = ValueArray(3)
    ws.Range("A3").Value = ValueArray(4)
    ws.Range("C3").Value = ValueArray(5)
    ws.Range("E3").Value = ValueArray(6)
    ws.Range("A5").Value = ValueArray(7)
    ws.Range("C5").Value = ValueArray(8)
    ws.Range("E5").Value = ValueArray(9)
    'Calculate sheet
    ws.Calculate
    'Check if your output is correct
    'Do stuff here?
End Sub