第一个 VBA 代码：运行时错误“1004”

Question

我收到一个运行时错误，但这可能是我遇到的最小问题。这个逻辑在我脑海中是有道理的，但我可能没有使用正确的语法或函数。我的代码在下面带有 cmets 和“希望”：

Sub Random_Points()

    Dim i As Integer
    Dim j As Integer
    Dim Max As Integer
    Dim RandomNumber As Integer

    Max = 100 '(Max is being multiplied by the Rnd function to provide a random number between 0-100)

    For i = 2 To 100 Step 1

    RandomNumber = Int(Rnd * Max)
    ThisWorkbook.Sheets("VBA").Cells(i, 2).Value = RandomNumber

    '(The for loop above with start assigned cells values starting with Cells(2,2) to Cells(100,2))
    '(I DO NOT WANT DUPLICATE VALUES...therefore after the value is assigned above I want the code to compare the newly assigned cell to all the cells above it.)

        For j = 1 To 98 Step 1

        '(...and IF the cell values are the same...)
        If ThisWorkbook.Sheets("VBA").Cells(i, 2).Value = ThisWorkbook.Sheets("VBA").Cells(i - j, 2).Value Then

            '(...A new random number will be assigned...)
            RandomNumber = Int(Rnd * Max)
            ThisWorkbook.Sheets("VBA").Cells(i, 2).Value = RandomNumber
        End If

        '(...and then re-checked vs all the others)
        Next j

        '(Next cell is assigned...loop restarts)
    Next i
End Sub

Answer 1

您的问题出在嵌套循环中。随着 j 的增加，它接近并最终等于 i。随后，当您使用.Cells(i - j, 2).Value 中的两个值时，没有行号小于1 的Range.Cells property。

解决方案是更改嵌套的 For ... Next 语句，使 j 永远不会到达 i。

'was ...
For j = 1 To 98 Step 1
'should be ...
For j = 1 To (i - 1) Step 1

在任何情况下，您只需要检查直到 i 的值。

fwiw，WorksheetFunction object 使用 MATCH function 和 VBA 的 IsError function 会更快。

Sub randomPoints_part_deux()
    Dim i As Long, mx As Long, randNum As Long

    mx = 100 '(mx is being multiplied by the Rnd function to provide a random number between 0-100)

    With ThisWorkbook.Sheets("VBA")
        'seed the column of numbers so you have something to check against
        randNum = Int(Rnd * mx)
        .Cells(2, 2) = randNum

        For i = 3 To 100 Step 1

            Do While Not IsError(Application.Match(randNum, .Range(.Cells(2, 2), .Cells(i - 1, 2)), 0))
                randNum = Int(Rnd * mx)
            Loop
            .Cells(i, 2) = randNum

        Next i
        'optional formula to count unique in C2
        .Cells(2, 3).Formula = "=SUMPRODUCT(1/COUNTIF(B2:B100, B2:B100))"
    End With
End Sub

Answer 2

由于您不希望重复，您可以生成随机数，然后反复检查它们是否已被使用，或者您可以先生成列表，然后随机从中提取。第二个选项更容易。

Sub Random100()

Dim i As Integer
Dim j As Integer
Dim Max As Integer
Dim RandomNumber As Integer
Dim cNum As New Collection

Max = 100 '(Max is being multiplied by the Rnd function to provide a random number between 0-100)

For i = 0 To Max 'fill collection with 0-100 in order
    cNum.Add i
Next i

k = cNum.Count - 1
For j = 0 To k
    RandomNumber = Int(Rnd * (k - j)) + 1
    ThisWorkbook.Sheets("VBA").Cells(j + 2, 2).Value = cNum(RandomNumber)
    cNum.Remove (RandomNumber)
Next j

End Sub

Answer 3

如果您的目的是获得一系列独特的价值，那么更好的方法是洗牌：

Const MIN = 1
Const MAX = 98

Dim values(MIN To MAX, 0 To 0) As Double, i&, irand&

' generate all the values
For i = MIN To MAX
  values(i, 0) = i
Next

' shuffle the values
For i = MIN To MAX
  irand = MIN + Math.Round(Rnd * (MAX - MIN))
  value = values(i, 0)
  values(i, 0) = values(irand, 0)
  values(irand, 0) = value
Next

' copy the values to the sheet
ThisWorkbook.Sheets("VBA").Range("A2").Resize(MAX - MIN + 1, 1) = values