Finance

Charts

Statistics

Macros

Search

Create Sudoku Puzzle with Excel VBA

  1. Set Up the Excel Sheet:

Before you start the VBA code, you should create a grid in Excel that represents the Sudoku board. You can do this by selecting a 9×9 range of cells (for example, A1:I9).

  1. VBA Code to Generate a Sudoku Puzzle:
Option Explicit
Dim SudokuGrid(1 To 9, 1 To 9) As Integer
Dim SolvedGrid(1 To 9, 1 To 9) As Integer
Sub GenerateSudokuPuzzle()
    Dim i As Integer, j As Integer
    ' Initialize the Sudoku grid
    Call GenerateSolution
    ' Remove some numbers to create the puzzle
    Call RemoveNumbers
    ' Display the puzzle in the Excel grid
    Call DisplayPuzzle
End Sub

Sub GenerateSolution()
    ' Fill the grid with a valid Sudoku solution
    Call FillGrid(1, 1)
End Sub

Function FillGrid(Row As Integer, Col As Integer) As Boolean
    Dim num As Integer
    If Row > 9 Then
        FillGrid = True
        Exit Function
    End If
    If Col > 9 Then
        FillGrid = FillGrid(Row + 1, 1)
        Exit Function
    End If
    If SudokuGrid(Row, Col) > 0 Then
        FillGrid = FillGrid(Row, Col + 1)
        Exit Function
    End If
    For num = 1 To 9
        If IsSafeToPlace(Row, Col, num) Then
            SudokuGrid(Row, Col) = num
            If FillGrid(Row, Col + 1) Then
                FillGrid = True
                Exit Function
            End If
            SudokuGrid(Row, Col) = 0
        End If
    Next num
    FillGrid = False
End Function

Function IsSafeToPlace(Row As Integer, Col As Integer, num As Integer) As Boolean
    ' Check if the number can be placed in the specified position
    Dim i As Integer, j As Integer
    ' Check the row
    For i = 1 To 9
        If SudokuGrid(Row, i) = num Then
            IsSafeToPlace = False
            Exit Function
        End If
    Next i
    ' Check the column
    For i = 1 To 9
        If SudokuGrid(i, Col) = num Then
            IsSafeToPlace = False
            Exit Function
        End If
    Next i
    ' Check the 3x3 box
    Dim startRow As Integer, startCol As Integer
    startRow = (Row - 1) \ 3 * 3 + 1
    startCol = (Col - 1) \ 3 * 3 + 1
    For i = startRow To startRow + 2
        For j = startCol To startCol + 2
            If SudokuGrid(i, j) = num Then
                IsSafeToPlace = False
                Exit Function
            End If
        Next j
    Next i
    IsSafeToPlace = True
End Function

Sub RemoveNumbers()
    Dim removed As Integer
    removed = 0
    Dim i As Integer, j As Integer
    Dim index As Integer
    Dim numbers(81) As Integer
    For i = 1 To 81
        numbers(i) = i
    Next i
    ' Shuffle numbers array
    For i = 1 To 81
        index = Int((81 - 1 + 1) * Rnd + 1)
        Dim temp As Integer
        temp = numbers(i)
        numbers(i) = numbers(index)
        numbers(index) = temp
    Next i
    ' Remove numbers to create the puzzle
    For i = 1 To 81
        Dim row As Integer, col As Integer
        row = (numbers(i) - 1) \ 9 + 1
        col = (numbers(i) - 1) Mod 9 + 1
        If SudokuGrid(row, col) <> 0 Then
            SudokuGrid(row, col) = 0
            removed = removed + 1
        End If
        If removed >= 40 Then Exit For
    Next i
End Sub

Sub DisplayPuzzle()
    Dim row As Integer, col As Integer
    For row = 1 To 9
        For col = 1 To 9
            If SudokuGrid(row, col) > 0 Then
                Cells(row, col).Value = SudokuGrid(row, col)
            Else
                Cells(row, col).Value = ""
            End If
        Next col
    Next row
End Sub

Explanation of the Code:

  1. Global Arrays (SudokuGrid, SolvedGrid):
    • SudokuGrid: This is the array that holds the current state of the puzzle. It will be filled with numbers from 1 to 9 for the solution, and some numbers will be removed to create the puzzle.
    • SolvedGrid: This array holds the full, completed Sudoku solution.
  2. Main Subroutine (GenerateSudokuPuzzle):
    • This is the main subroutine that drives the generation of the Sudoku puzzle. It first calls GenerateSolution to create a valid solution, then it calls RemoveNumbers to remove some numbers from the grid to make it a puzzle, and finally, it displays the puzzle in the Excel worksheet using DisplayPuzzle.
  3. Generating the Solution (GenerateSolution):
    • The GenerateSolution subroutine calls the FillGrid function, which is a recursive function that attempts to fill the grid with a valid solution.
  4. Filling the Grid (FillGrid):
    • This function tries to fill the Sudoku grid row by row, column by column, and uses backtracking to find a valid configuration. If it encounters a situation where a number cannot be placed, it backtracks and tries another number.
  5. Safety Check (IsSafeToPlace):
    • This function checks if placing a specific number in a given cell violates the Sudoku rules. It checks the current row, column, and the 3×3 subgrid to ensure the number doesn’t appear elsewhere.
  6. Removing Numbers (RemoveNumbers):
    • After the grid has been filled with a valid solution, the RemoveNumbers subroutine randomly removes numbers from the grid to create the puzzle. It ensures that there are enough numbers removed (about 40 cells) to create a solvable puzzle.
  7. Displaying the Puzzle (DisplayPuzzle):
    • This subroutine loops through the SudokuGrid and displays the numbers in the corresponding cells of the Excel sheet. If a cell contains a zero, it will display nothing.

How to Use the Code:

  1. Open your Excel workbook and press ALT + F11 to open the VBA editor.
  2. Insert a new module by clicking Insert > Module.
  3. Paste the entire code into the module.
  4. Close the VBA editor and return to your Excel workbook.
  5. Run the GenerateSudokuPuzzle macro by pressing ALT + F8, selecting GenerateSudokuPuzzle, and clicking « Run ».

This code will generate a random Sudoku puzzle every time it’s run, with some cells filled and others left empty. You can adjust the number of cells to remove by changing the condition in RemoveNumbers (currently set to remove 40 cells).

0 0 votes
Évaluation de l'article
S’abonner
Notification pour
guest
0 Commentaires
Le plus ancien
Le plus récent Le plus populaire
Online comments
Show all comments
Facebook
Twitter
LinkedIn
WhatsApp
Email
Print
0
We’d love to hear your thoughts — please leave a commentx