我的 VB 代码一直在下面，并不断生成运行时错误 13。不知道为什么。有人能指出下面的代码有什么问题吗？
Sub GenerateUniqueData()
Dim ws As Worksheet
Dim i As Long, j As Long
Dim firstNames() As String
Dim lastNames() As String
Dim usedNames As Object
Dim fullName As String
Set ws = ActiveSheet
Set usedNames = CreateObject("Scripting.Dictionary")
' Clear existing data
ws.Range("A2:E1001").Clear
' Add headers
ws.Cells(1, 1).Value = "Full Name"
ws.Cells(1, 2).Value = "Age"
ws.Cells(1, 3).Value = "Height (cm)"
ws.Cells(1, 4).Value = "Weight (kg)"
ws.Cells(1, 5).Value = "Bone Density"
' Define larger arrays of first names and last names
firstNames = Array("John", "Maria", "Robert", "Emily", "Michael", "Sarah", "David", "Lisa", "James", "Karen", _
"William", "Jennifer", "Richard", "Elizabeth", "Thomas", "Nancy", "Charles", "Patricia", "Daniel", "Linda", _
"Matthew", "Barbara", "Anthony", "Margaret", "Donald", "Susan", "Mark", "Dorothy", "Paul", "Jessica", _
"Steven", "Ashley", "Andrew", "Kimberly", "Kenneth", "Donna", "Joshua", "Carol", "George", "Michelle", _
"Kevin", "Amanda", "Brian", "Betty", "Edward", "Melissa", "Ronald", "Deborah", "Timothy", "Stephanie")
lastNames = Array("Smith", "Garcia", "Johnson", "Chen", "Brown", "Davis", "Wilson", "Anderson", "Taylor", "Lee", _
"White", "Harris", "Martin", "Thompson", "Moore", "Young", "Allen", "King", "Wright", "Scott", _
"Green", "Baker", "Adams", "Nelson", "Hill", "Ramirez", "Campbell", "Mitchell", "Roberts", "Carter", _
"Phillips", "Evans", "Turner", "Torres", "Parker", "Collins", "Edwards", "Stewart", "Flores", "Morris", _
"Nguyen", "Murphy", "Rivera", "Cook", "Rogers", "Morgan", "Peterson", "Cooper", "Reed", "Bailey")
' Generate 1000 rows of data
For i = 2 To 1001
' Generate unique full name
Do
fullName = firstNames(Int(Rnd() * UBound(firstNames))) & " " & lastNames(Int(Rnd() * UBound(lastNames)))
Loop While usedNames.Exists(fullName)
usedNames.Add fullName, Nothing
' Full Name
ws.Cells(i, 1).Value = fullName
' Age
ws.Cells(i, 2).Value = Application.WorksheetFunction.RandBetween(18, 80)
' Height
ws.Cells(i, 3).Value = Application.WorksheetFunction.RandBetween(150, 200)
' Weight
ws.Cells(i, 4).Value = Application.WorksheetFunction.RoundUp(Application.WorksheetFunction.Norm_Inv(Rnd(), 70, 15), 0)
' Bone Density
ws.Cells(i, 5).Value = Round(Application.WorksheetFunction.Norm_Inv(Rnd(), 1.2, 0.05), 2)
Next i
' Format headers
ws.Range("A1:E1").Font.Bold = True
MsgBox "Data generation complete!", vbInformation
End Sub
两个选项（类型不匹配错误）
Sub TwoOptions()
' The 'Array' function produces a 1D Variant array.
' If you prepend 'VBA.', you're ensuring it is a zero-based array.
Dim FirstNames() As Variant: FirstNames = VBA.Array( _
"John", "Maria", "Robert", "Emily", "Michael")
Debug.Print Join(FirstNames, ", ")
' The 'Split' function produces a 1D zero-based String array.
Const FirstNamesList As String = "John,Maria,Robert,Emily,Michael"
Dim sFirstNames() As String: sFirstNames = Split(FirstNamesList, ",")
Debug.Print Join(FirstNames, ", ")
End Sub
Do Loop改进 - 主要
Sub GenerateUniqueData()
Const FIRST_CELL_ADDRESS As String = "A1"
Const RECORDS_COUNT As Long = 10
Dim HEADERS() As Variant: HEADERS = VBA.Array( _
"Full Name", "Age", "Height (cm)", "Weight (kg)", "Bone Density")
Dim FirstNames() As Variant: FirstNames = VBA.Array( _
"John", "Maria", "Robert", "Emily", "Michael", _
"Sarah", "David", "Lisa", "James", "Karen", _
"William", "Jennifer", "Richard", "Elizabeth", "Thomas", _
"Nancy", "Charles", "Patricia", "Daniel", "Linda", _
"Matthew", "Barbara", "Anthony", "Margaret", "Donald", _
"Susan", "Mark", "Dorothy", "Paul", "Jessica", _
"Steven", "Ashley", "Andrew", "Kimberly", "Kenneth", _
"Donna", "Joshua", "Carol", "George", "Michelle", _
"Kevin", "Amanda", "Brian", "Betty", "Edward", _
"Melissa", "Ronald", "Deborah", "Timothy", "Stephanie")
Dim LastNames() As Variant: LastNames = VBA.Array( _
"Smith", "Garcia", "Johnson", "Chen", "Brown", _
"Davis", "Wilson", "Anderson", "Taylor", "Lee", _
"White", "Harris", "Martin", "Thompson", "Moore", _
"Young", "Allen", "King", "Wright", "Scott", _
"Green", "Baker", "Adams", "Nelson", "Hill", _
"Ramirez", "Campbell", "Mitchell", "Roberts", "Carter", _
"Phillips", "Evans", "Turner", "Torres", "Parker", _
"Collins", "Edwards", "Stewart", "Flores", "Morris", _
"Nguyen", "Murphy", "Rivera", "Cook", "Rogers", _
"Morgan", "Peterson", "Cooper", "Reed", "Bailey")
Dim ColumnsCount As Long: ColumnsCount = UBound(HEADERS) + 1 ' e.g.
If ActiveSheet Is Nothing Then
MsgBox "There is no ActiveSheet!", vbExclamation
Exit Sub
End If
If Not TypeOf ActiveSheet Is Worksheet Then
MsgBox "The active sheet is not a worksheet!", vbExclamation
Exit Sub
End If
Dim ws As Worksheet: Set ws = ActiveSheet
' Return all full names in a 1D one-based String array.
Dim FullNames() As String: ReDim FullNames(1 To _
(UBound(FirstNames) + 1) * (UBound(LastNames) + 1))
Dim f As Long, l As Long, r As Long
For f = 0 To UBound(FirstNames)
For l = 0 To UBound(LastNames)
r = r + 1
FullNames(r) = FirstNames(f) & " " & LastNames(l)
Next l
Next f
' Shuffle the array.
ShuffleArray FullNames, RECORDS_COUNT
' Write the results to the destination 2D one-based array.
Dim drCount As Long: drCount = RECORDS_COUNT + 1
Dim Data() As Variant: ReDim Data(1 To drCount, 1 To ColumnsCount)
' Write headers.
For r = 1 To ColumnsCount
Data(1, r) = HEADERS(r - 1)
Next r
' Write data.
With Application
For r = 2 To drCount
Data(r, 1) = FullNames(r - 1) ' full name (no headers, right?)
Data(r, 2) = .RandBetween(18, 80) ' age
Data(r, 3) = .RandBetween(150, 200) ' height
Data(r, 4) = .RoundUp(.Norm_Inv(Rnd(), 70, 15), 0) ' weight
Data(r, 5) = Round(.Norm_Inv(Rnd(), 1.2, 0.05), 2) ' bone density
Next r
End With
With ws.Range(FIRST_CELL_ADDRESS).Resize(, ColumnsCount)
' Clear existing.
.Resize(ws.Rows.Count - .Row + 1).Clear
' Write new.
.Resize(drCount).Value = Data
' Format.
.Font.Bold = True
'.EntireColumn.AutoFit
End With
MsgBox "Data generation complete!", vbInformation
End Sub
改进 - 帮助
Sub ShuffleArray(ByRef Arr As Variant, _
Optional ByVal RecordsCount As Variant)
Dim LB As Long: LB = LBound(Arr)
Dim UB As Long: UB = UBound(Arr)
Dim Count As Long: Count = UB - LB + 1
If Not IsMissing(RecordsCount) Then
If IsNumeric(RecordsCount) Then
If RecordsCount < Count Then Count = RecordsCount
End If
End If
Dim Temp As Variant, i As Long, j As Long, c As Long
For i = LB To UBound(Arr) - 1
j = Int((UB - i + 1) * Rnd + i)
Temp = Arr(i): Arr(i) = Arr(j): Arr(j) = Temp
c = c + 1
If c = Count Then Exit For
Next i
End Sub