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))来测试数字Value是否在{{1}中的任何地方使用过}。

一旦找到“有效”的解决方案，就可以停止循环（除非您想查看有多少个有效的解决方案）-为此，我可能会大喊大叫并遭到某些人的抨击，但是Array是一种快速，肮脏且简单的解决方案

除此之外，我将使用一些CodeGolf技巧来使代码在视觉上更短，例如使用Type Characters来简化GoTo语句或链接的{{1 }}语句-而不是在生成每个数字后检查输出是否仍然有效，而是在生成所有9后执行一次。

Dim

或者，您可以使用递归子例程（即调用自身的子例程）的弊端依次遍历数组中每个项目的数字。（正确使用时功能强大，但会出错，最终将计算机锁定在永久循环中，Excel / VBA占用越来越多的内存）

Next

Answer 2

我建议您采用以下方式解决此类问题：
为变量指定一些明确的名称，例如a1，a2，...，如下所示：

first row  :  a1  a2  a3
second row :  b1  b2  b3
third row  :  c1  c2  c3

然后您的算法可能如下所示（伪代码）：

for a1 = 0 to 9:
  for a2 = 0 to 9:
    if (a1 <> a2) // all have to be different
    then:
      for a3 = 0 to 9:
      if ((a1 <> a3) and (a2 <> a3)) and // all have to be different
         (a1 - a2 / a3 = 1)              // start checking if the first row is correct,
                                         // otherwise it makes no sense to continue.
      then:
      ...

祝你好运

Answer 3

要生成1到9个数字的随机排列，不重复，请选择一个单元格，说出 G1 并输入：

=RANDBETWEEN(1,9)

然后在 G2 中输入：

=LARGE(IF(ISNA(MATCH({1;2;3;4;5;6;7;8;9},G$1:G1,0)),{1;2;3;4;5;6;7;8;9}),RANDBETWEEN(1,9-ROWS(G$2:G2)))

并向下复制。

每次重新计算工作表时，都会计算一个新的排列。

该列填充完毕后，可以使用以下公式将其映射到任何矩形数组中：

=G1

Answer 4

处理内存中难题的蛮力方法需要588.03 Seconds(s)处理您的难题，而212.79 Seconds(s)处理this puzzle。我的游戏计算机可能会在不到一半的时间内处理完毕。

Sub SolveCrossSum()
    Dim t As Double: t = Timer

    Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, n6 As Long, n7 As Long, n8 As Long, n9 As Long
    Dim Data() As Variant
    Dim result As String

    With Worksheets("Sheet3")
        Data = .Range("A1:G7").Value
        For n1 = 1 To 9
            For n2 = 1 To 9
                For n3 = 1 To 9
                    For n4 = 1 To 9
                        For n5 = 1 To 9
                            For n6 = 1 To 9
                                For n7 = 1 To 9
                                    For n8 = 1 To 9
                                        For n9 = 1 To 9
                                            If Solved(Data, t, n1, n2, n3, n4, n5, n6, n7, n8, n9) Then
                                                .Range("A1:E5").Value = Data
                                                Debug.Print "Cross Sum was solved in: "; Round((Timer - t), 2); " Seconds(s)"
                                                Exit Sub
                                            End If
                                        Next
                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
    End With
    Debug.Print "No Answer Found for Cross Sum.  Execution Time: "; Round((Timer - t) / 60, 2); " Minutes(s)"
    Debug.Print n1, n2, n3, n4, n5, n6, n7, n8, n9
End Sub


Function Solved(ByRef Data() As Variant, t As Double, n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long, n6 As Long, n7 As Long, n8 As Long, n9 As Long) As Boolean
    If hasDuplicates(n1, n2, n3, n4, n5, n6, n7, n8, n9) Then Exit Function

    If ev(ev(n1, n2, Data(1, 2)), n3, Data(1, 4)) <> Data(1, 7) Then Exit Function
    If ev(ev(n4, n5, Data(3, 2)), n6, Data(3, 4)) <> Data(3, 7) Then Exit Function
    If ev(ev(n7, n8, Data(5, 2)), n9, Data(5, 4)) <> Data(5, 7) Then Exit Function

    If ev(ev(n1, n4, Data(2, 1)), n7, Data(4, 1)) <> Data(7, 1) Then Exit Function
    If ev(ev(n2, n5, Data(2, 3)), n8, Data(4, 3)) <> Data(7, 3) Then Exit Function
    If ev(ev(n3, n6, Data(2, 5)), n9, Data(4, 5)) <> Data(7, 5) Then Exit Function

    Data(1, 1) = n1
    Data(1, 3) = n2
    Data(1, 5) = n3
    Data(3, 1) = n4
    Data(3, 3) = n5
    Data(3, 5) = n6
    Data(5, 1) = n7
    Data(5, 3) = n8
    Data(5, 5) = n9
    Solved = True
End Function

Function ev(v1 As Long, v2 As Long, operator As Variant) As Long
    Select Case operator
        Case "+"
            ev = v1 + v2
        Case "-"
            ev = v1 - v2
        Case "/"
            ev = v1 / v2
        Case "*"
            ev = v1 * v2
    End Select
End Function

Function hasDuplicates(ParamArray Args() As Variant) As Boolean
    Dim n1 As Long, n2 As Long
    For n1 = 0 To UBound(Args)
        If Args(n1) = 10 Then Exit Function
        For n2 = 0 To UBound(Args)
            If n1 <> n2 Then
                If Args(n1) = Args(n2) Then
                    hasDuplicates = True
                    Exit Function
                End If
            End If
        Next
    Next
End Function

同一单元格中所有1到9的所有可能组合，无需重复

4 个答案: