Excel 在VBA中使用ArrayList

我目前正在修改一个模式严重的excel时间表工作簿。我有一个治疗师列表主列表（治疗师选择表），当选中复选框并按下魔术按钮时，我想查看列表以检查指定范围内目标表（所有治疗师）中的姓名

如果治疗师没有检查，那么程序会删除这些行的必要数据，并对所有内容进行排序。那部分很好用

下一步，我希望程序在下一个开放点中输入尚未存在的名称。我试图通过首先填充一个

ArrayList

来实现这一点，该列表中包含所有经过检查的名称

如果程序发现了一个副本，我会让它从数组中删除该副本。然后，当删除重复项后，它会循环遍历名称，并在列的第一个单元格中打印每个名称，并使用hypen（所有空单元格都变成连字符）

我不能让它工作。我不断地得到一份工作

运行时错误-2146233079 80131509

有没有人能找到更好的方法来处理这个问题？或者至少看看我错在哪里

第一个子系统调用第二个子系统来清除和排序：

Private Sub AddDailyTherapists(PasteToRange As range, TrueFalseRange As range, StartCell As range, SortRange As range)
    Call ClearUnselectedTherapists(PasteToRange, TrueFalseRange, StartCell, SortRange)
    Dim Names As Object
    Set Names = CreateObject("System.Collections.ArrayList")
    For Each cel In TrueFalseRange
        If cel.value = True Then
            Names.Add cel.Parent.Cells(cel.Row, 4).value
        End If
    Next cel
    For Each n In PasteToRange
        For Each nm In Names
            If nm = n.value Then
                Names.Remove nm
            End If
        Next nm
    Next n
    StartCell.Activate
    For Each nm In Names
        Do While (ActiveCell.value <> "-")
            ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
        Loop
        ActiveCell.value = nm
    Next nm
End Sub

Public Sub ClearUnselectedTherapists(PasteToRange As range, TrueFalseRange As range, StartCell As range, SortRange As range)
    Sheets("All Therapists").Activate
    StartCell.Activate
    For Each cell In TrueFalseRange
        If cell.value = False Then
            Name = cell.Parent.Cells(cell.Row, 4).value
            For Each cel In PasteToRange
                If Name = cel.value Then
                    cel.value = "-"
                    cel.Offset(0, 1).range("A1:R1").Select
                    Selection.ClearContents
                    Exit For
                End If
            Next cel
        End If
    Next cell
    With ActiveWorkbook.Worksheets("All Therapists").Sort
        .SetRange SortRange
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub 

Private Sub addDaily治疗师（粘贴范围为范围，TrueTFalseRange范围为范围，StartCell范围为范围，SortRange范围为范围）
呼叫ClearUnselectedThermators（粘贴范围、TrueFalseRange、StartCell、SortRange）
将名称变暗为对象
Set name=CreateObject（“System.Collections.ArrayList”）
对于TrueFalse范围内的每个cel
如果cel.value=True，则
name.Add cel.Parent.Cells（cel.Row，4）.value
如果结束
下一个细胞
对于粘贴范围中的每n
对于名称中的每个nm
如果nm=n.值，则
名称。删除nm
如果结束
下一纳米
下一个
StartCell，启动
对于名称中的每个nm
Do While（ActiveCell.value“-”号）
ActiveCell.Offset（行偏移量=1，列偏移量=0）。激活
环
ActiveCell.value=nm
下一纳米
端接头
公共次清除未选择的治疗师（粘贴范围为范围、TrueTorRange范围为范围、StartCell范围为范围、SortRange范围为范围）
床单（“所有治疗师”）。激活
StartCell，启动
对于TrueFalseRange中的每个单元格
如果cell.value=False，则
名称=cell.Parent.Cells（cell.Row，4）.value
对于PasteToRange中的每个cel
如果Name=cel.value，则
cel.value=“-”
单元格偏移量（0，1）。范围（“A1:R1”）。选择
选择.ClearContents
退出
如果结束
下一个细胞
如果结束
下一个细胞
使用ActiveWorkbook.Worksheets（“所有治疗师”）.Sort
.SetRange排序规则
.方向=xlTopToBottom
.SortMethod=xl拼音
.申请
以
端接头

修改后的电子表格：

带有复选框的工作表：

Private Sub AddDailyTherapists(PasteToRange As range, TrueFalseRange As range, StartCell As range, SortRange As range)
'
Call ClearUnselectedTherapists(PasteToRange, TrueFalseRange, StartCell, SortRange)

Dim Names(0 To 11) As String
i = 0
For Each cel In TrueFalseRange
    If cel.value = True Then
        Names(i) = cel.Parent.Cells(cel.Row, 4).value
        i = i + 1
    End If
Next cel
For Each n In PasteToRange
    For j = 0 To UBound(Names)
        If Names(j) = n.value Then
            Names(j) = ""
        End If
    Next j
Next n
StartCell.Activate
For k = 0 To UBound(Names)
    Do While (ActiveCell.value <> "-")
        ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
    Loop
    If Names(k) <> "" Then
        ActiveCell.value = Names(k)
    End If
Next k

私人助理日常治疗师（粘贴范围为范围、TrueTorRange范围为范围、StartCell范围为范围、SortRange范围为范围）
'
呼叫ClearUnselectedThermators（粘贴范围、TrueFalseRange、StartCell、SortRange）
Dim名称（0到11）作为字符串
i=0
对于TrueFalse范围内的每个cel
如果cel.value=True，则
名称（i）=cel.Parent.Cells（cel.Row，4）.value
i=i+1
如果结束
下一个细胞
对于粘贴范围中的每n
对于j=0到UBound（名称）
如果名称（j）=n.值，则
姓名（j）=“”
如果结束
下一个j
下一个
StartCell，启动
对于k=0到UBound（名称）
Do While（ActiveCell.value“-”号）
ActiveCell.Offset（行偏移量=1，列偏移量=0）。激活
环
如果名称（k）“，则
ActiveCell.value=名称（k）
如果结束
下一个k

---

End Sub

哪一行准确地抛出了错误？下一个NM是删除循环。我最终能够用数组而不是数组列表完成它。谢谢@TimWilliams，我也不知道！