VBA: добавление случайных чисел в сетке, что ARENT уже в сетке

Question

Sub FWP() 

Dim i As Integer 
Dim j As Integer 
Dim n As Integer 
n = Range("A1").Value 

For i = 1 To n 
    For j = 1 To n 

    If Cells(i + 1, j) = 0 Then 
     Cells(i + 1, j).Value = Int(((n^2) - 1 + 1) * Rnd + 1) 
    ElseIf Cells(i + 1, j) <> 0 Then 
     Cells(i + 1, j).Value = Cells(i + 1, j).Value 
    End If 
    Next j 
Next i 

Я пытаюсь сделать часть домашнего задания вопроса, который просит, чтобы заполнить недостающие пробелы в магическом квадрате в VBA. Он настроен как матрица (n x n) с числами n^2; пробелы, которые нужно заполнить, представлены нулями в матрице. Пока у меня есть код, который проверяет каждое отдельное значение ячейки и оставит значения в одиночку, если не 0, а если значение равно 0, оно заменяет их случайным числом между 1 и n^2. Проблема в том, что, очевидно, я получаю некоторые повторяющиеся значения, которые недопустимы, должно быть только 1 из каждого числа.

Как мне закодировать его так, чтобы в сетке не было повторяющихся чисел? Я пытаюсь поставить в функции проверки, чтобы увидеть, если они уже в сети, но я не знаю, как сделать это

Благодарности

Answer 1

Никто не собирается делать свою домашнюю работу для вас. Вы только обманываете себя. Позор им, если они это сделают.

Я не уверен, насколько вы извращен ваш учитель, но есть много способов решить эту проблему.

Вы можете поместить значения матрицы в массив. Проверьте, существует ли элемент нулевого значения, если нет, break. Затем получите свое потенциальное случайное число для вставки. Итерацию через массив с циклом for, проверяющим каждый элемент для этого значения. Если его нет, замените нулевой элемент.

Answer 2

Существует много подходов, которые вы можете предпринять, но @CMArg прав, говоря, что массив или словарь - хороший способ убедиться, что у вас нет дубликатов.

То, что вы хотите избежать, - это сценарий, в котором каждая ячейка постепенно увеличивается до заполнения. Это не проблема для очень маленького квадрата (например, 10x10), но очень большие квадраты могут стать уродливыми. (Если ваш диапазон 1-100, и все цифры, кроме 31, уже находятся в таблице, это займет много времени - 100 догадок в среднем, правильно? - чтобы вытащить один неиспользованный номер. Если диапазон равен 1 -40000 (200x200), для заполнения последней ячейки потребуется 40000 догадок.)

Таким образом, вместо того, чтобы вести список номеров, которые уже были использованы, подумайте о том, как вы можете эффективно пройти и «перечеркнуть», уже используемые числа, так что каждая новая ячейка принимает ровно 1 «предположение» для заполнения.

Вот один из способов вы можете реализовать:

Класс: SingleRandoms

Option Explicit 

Private mUnusedValues As Scripting.Dictionary 
Private mUsedValues As Scripting.Dictionary 

Private Sub Class_Initialize() 
    Set mUnusedValues = New Scripting.Dictionary 
    Set mUsedValues = New Scripting.Dictionary 
End Sub 

Public Sub GenerateRange(minimumNumber As Long, maximumNumber As Long) 
    Dim i As Long 
    With mUnusedValues 
    .RemoveAll 
    For i = minimumNumber To maximumNumber 
     .Add i, i 
    Next 
    End With 
End Sub 

Public Function GetRandom() As Long 
    Dim i As Long, keyID As Long 
    Randomize timer 
    With mUnusedValues 
    i = .Count 
    keyID = Int(Rnd * i) 
    GetRandom = .Keys(keyID) 
    .Remove GetRandom 
    End With 
    mUsedValues.Add GetRandom, GetRandom 
End Function 

Public Property Get AvailableValues() As Scripting.Dictionary 
    Set AvailableValues = mUnusedValues 
End Property 

Public Property Get UsedValues() As Scripting.Dictionary 
    Set UsedValues = mUsedValues 
End Property 

Пример класса в действии:

Public Sub getRandoms() 
Dim r As SingleRandoms 
Set r = New SingleRandoms 
With r 
    .GenerateRange 1, 100 
    Do Until .AvailableValues.Count = 0 
    Debug.Print .GetRandom() 
    Loop 
End With 
End Sub 

Использование коллекции фактически будет больше памяти эффективнее и быстрее, чем использование словаря, но словарь упрощает проверку того, что он делает то, что он поддерживает sed делать (поскольку вы можете использовать .Exists и т. д.).