背景：您将在下面查看的代码用于访客列表。执行时，它将询问名字列表，姓氏列表，电子邮件地址列表，点值和事件名称。然后，程序在第一个空列的第一行输入事件名称。然后，if循环将每个提供它的名称检查为电子表格中现有列表的列表。如果找到名字和姓氏，则会将该点值添加到该行的新事件列。如果找不到名称，则会将名字和姓氏添加到底部的新行，电子邮件地址，总计的两个公式，然后是新列中的点值。这是预期的方案。
我首先使用以下代码获取名称列表
Dim fNameStringRange As Range
fNameStringRange = Application.InputBox("Select the list of first names.", "Obtain Range Object", Type:=8)
然后我使用用户函数RangeToArray转换它。代码如下：
Function RangeToArray(inputRange As Range) As Variant
Dim inputArray As Variant
inputArray = inputRange.Value
'operations on inputArray
'...'
RangeToArray = inputArray
End Function
Dim fNameString As Variant
fNameString = RangeToArray(fNameStringRange)
但出于某种原因，我的代码不会这样处理。当我把这些名字填入我的表格时，它不会填写任何内容。之前，使用InputBox type:=2可以正常工作。任何帮助表示赞赏。我的完整VBA脚本如下：
Sub addEvent()
On Error Resume Next
Dim fNameStringRange As Range
Dim lNameStringRange As Range
Dim sEmailStringRange As Range
Dim fNameString As Variant
Dim lNameString As Variant
Dim sEmailString As Variant
Dim nPointVal As Integer
Dim sEventName As String
Dim n As Integer, r As Long, c As Range, d As Range, e As Range, p As Range, sE As Range
Dim fName As Range, lName As Range, sEmail As Range, z As Range
Dim lEvent As Integer
Set fName = ActiveSheet.Range("FirstName")
Set lName = ActiveSheet.Range("LastName")
Set sEmail = ActiveSheet.Range("eMailAddr")
fNameStringRange = Application.InputBox("Select the list of first names.", "Obtain Range Object", Type:=8)
lNameStringRange = Application.InputBox("Select the list of last names.", "Obtain Range Object", Type:=8)
sEmailStringRange = Application.InputBox("Select the list of email addresses.", "Obtain Range Object", Type:=8)
fNameString = RangeToArray(fNameStringRange)
lNameString = RangeToArray(lNameStringRange)
sEmailString = RangeToArray(sEmailStringRange)
nPointVal = InputBox("Please enter a point value for this event")
sEventName = InputBox("Please enter the name of the event.")
lEvent = NextEmptyColumn(Range("A1"))
Set sE = Range("A1").Offset(0, lEvent)
sE.Value = sEventName
' sEventPos = sE.Offset(0, lEvent)
If fNameString <> False And lNameString <> False Then
For i = LBound(fNameString) To UBound(fNameString)
fNameString(i) = Trim(fNameString(i)) ' Trim off leading and trailing whitespace.
lNameString(i) = Trim(lNameString(i)) ' Trim off leading and trailing whitespace.
Set c = fName.Find(fNameString(i), LookIn:=xlValues, LookAt:=xlWhole)
Set d = lName.Find(lNameString(i), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing And Not d Is Nothing Then
Set p = c.Offset(0, lEvent)
p.Value = nPointVal
ElseIf c Is Nothing And d Is Nothing Or c Is Nothing And Not d Is Nothing _
Or Not c Is Nothing And d Is Nothing Then
Set c = fName.End(xlDown).Offset(1, 0)
c.Value = fNameString(i)
Set d = lName.End(xlDown).Offset(1, 0)
d.Value = lNameString(i)
Set e = sEmail.End(xlDown).Offset(1, 0)
e.Value = sEmailString(i)
Set p = fName.End(xlDown).Offset(0, lEvent)
p.Value = nPointVal
Dim s As Range ' Our summation range
Set s = Range(c.Offset(0, 4), c.Offset(0, 4))
Dim rD As Integer
rD = Application.WorksheetFunction.RoundDown((s.Address / 250), 0)
c.Offset(0, 3).Formula = "=((" & s.Address & "/250)-ROUNDDOWN((" & s.Address & "/250),0))*250"
Set s = Range(c.Offset(0, 5), c.Offset(0, 42))
c.Offset(0, 4).Formula = "=SUM(" & s.Address & ")"
c.Offset(0, 5).Value = 0
End If
Next
End If
End Sub
答案 0 :(得分：1)
以下是一些要求的修改。看起来最大的问题不是阵列，而是你不清楚c和d这意味着测试没有转移到其他条件。 我不能确定这个原因我必须玩一些东西，做出假设并制作数据。但我希望现在能让你走上正轨。
Sub addEvent()
On Error Resume Next
Dim fNameString As Variant
Dim lNameString As Variant
Dim sEmailString As Variant
Dim nPointVal As Integer
Dim sEventName As String
Dim n As Integer, r As Long, c As Range, d As Range, e As Range, p As Range, sE As Range
Dim fName As Range, lName As Range, sEmail As Range, z As Range
Dim lEvent As Integer
Set fName = ActiveSheet.Range("FirstName")
Set lName = ActiveSheet.Range("LastName")
Set sEmail = ActiveSheet.Range("eMailAddr")
fNameString = Application.InputBox("Select the list of first names.", "Obtain Range Object", Type:=8)
lNameString = Application.InputBox("Select the list of last names.", "Obtain Range Object", Type:=8)
sEmailString = Application.InputBox("Select the list of email addresses.", "Obtain Range Object", Type:=8)
nPointVal = InputBox("Please enter a point value for this event")
sEventName = InputBox("Please enter the name of the event.")
lEvent = NextEmptyColumn(Range("A1"))
Set sE = Range("A1").Offset(0, lEvent)
sE.Value = sEventName
' sEventPos = sE.Offset(0, lEvent)
If fNameString <> False And lNameString <> False Then
For i = LBound(fNameString) To UBound(fNameString)
'clear the range variables to ensure the tests are correctly applied
'was previously retaining old value and not progressing to second condition
Set c = Nothing: Set d = Nothing: Set p = Nothing
fNameString(i, 1) = Trim(fNameString(i, 1)) ' Trim off leading and trailing whitespace.
lNameString(1, 1) = Trim(lNameString(i, 1)) ' Trim off leading and trailing whitespace.
Set c = fName.Find(fNameString(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
Set d = lName.Find(lNameString(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing And Not d Is Nothing Then
Set p = c.Offset(0, lEvent)
p.Value = nPointVal
ElseIf c Is Nothing Or d Is Nothing Then
Set c = fName.End(xlDown).Offset(1, 0)
c.Value = fNameString(i, 1)
Set d = lName.End(xlDown).Offset(1, 0)
d.Value = lNameString(i, 1)
Set e = sEmail.End(xlDown).Offset(1, 0)
e.Value = sEmailString(i, 1)
Set p = fName.End(xlDown).Offset(0, lEvent)
p.Value = nPointVal
Dim s As Range ' Our summation range
Set s = Range(c.Offset(0, 4), c.Offset(0, 4))
Dim rD As Integer
rD = Application.WorksheetFunction.RoundDown((s.Address / 250), 0)
c.Offset(0, 3).Formula = "=((" & s.Address & "/250)-ROUNDDOWN((" & s.Address & "/250),0))*250"
Set s = Range(c.Offset(0, 5), c.Offset(0, 42))
c.Offset(0, 4).Formula = "=SUM(" & s.Address & ")"
c.Offset(0, 5).Value = 0
End If
Next
End If
End Sub