VBA ActiveX ComboBox引发Excel崩溃问题求助

我制作了一个Excel工具用于协助职业经理规划员工未来岗位，工作表内的表格包含员工当前岗位信息、起止日期，以及最多三个未来岗位的信息与起止日期。

工作表顶部设有一个名为CmboPERS的ComboBox控件，用户可通过它从表格中选择员工，点击「Open Form」按钮后会打开已填充该员工信息的UserForm，用于制定员工未来岗位规划。用户在表单中输入的未来岗位计划，点击「更新记录」按钮后会同步至工作表表格。

为选择要添加到职业规划的岗位，用户点击表单中的「Select」按钮会打开子UserForm「SelPost」，通过一系列关联的ComboBox从另一工作表的岗位表格中查找目标岗位。

首次选择员工时所有功能正常，但当用户再次操作CmboPERS选择其他员工时，Excel会在执行CmboPERS的事件代码（如DropButtonClick）时崩溃，调试确认代码执行到End Sub时程序崩溃。

经测试得出以下规律：

• 若不与子UserForm中的ComboBox交互，仅修改员工表单的日期并更新记录，后续可正常操作CmboPERS；
• 仅需与子UserForm的第一个ComboBox（ComboBox1）交互后点击取消，就会导致CmboPERS失效、Excel崩溃。

CmboPERS的代码 #

Option Explicit
Dim Dict As Object
Dim pList As Variant
Private IsChanged As Boolean
 
Private Sub CmboPERS_DropButtonClick()
 
    pList = ThisWorkbook.Sheets("Posting plot").ListObjects("PERS").ListColumns("PER").DataBodyRange.Value
    Set Dict = CreateObject("scripting.dictionary")
    Dict.CompareMode = vbTextCompare
    Dim i As Long
 
    For i = LBound(pList) To UBound(pList)
        If Len(pList(i, 1)) > 7 Then
        Dict(pList(i, 1)) = Empty
        End If
    Next
        CmboPERS.List = Dict.Keys
        Dict.RemoveAll
        CmboPERS.ListRows = Application.WorksheetFunction.Min(6, CmboPERS.ListCount)
End Sub
  
Private Sub CmboPERS_Change()
 
    Dim i As Long
    Me.CmboPERS.ListRows = Application.WorksheetFunction.Min(6, Me.CmboPERS.ListCount)
 
    If Not IsChanged Then
        With Me.CmboPERS
            If .Value <> "" Then
                .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
                .DropDown
                If Len(.Text) Then
                    For i = .ListCount - 1 To 0 Step -1
                        If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then
                            .RemoveItem i
                        End If
                    Next
 
                End If
            End If
        End With
 
    End If
 
End Sub

'code to manage the user typing text into CmboPERS
 
Private Sub CmboPERS_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 
    IsChanged = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    If (KeyCode = vbKeyReturn Or KeyCode = vbKeyBack) Then
        Dim i As Long
 
        For i = LBound(pList) To UBound(pList)
            If Len(pList(i, 1)) > 7 Then
                Dict(pList(i, 1)) = Empty
            End If
        Next
        CmboPERS.List = Dict.Keys
 
        Dict.RemoveAll
    End If
 
End Sub

子UserForm「SelPost」的部分代码 #

Option Explicit
Dim kList As Variant
Dim Post As Variant
Private IsArrow As Boolean
Dim d As Object

Private Sub CmdBCancel_Click()
   d.RemoveAll
   ComboBox1.Clear
   ComboBox2.Clear
   ComboBox3.Clear
   ComboBox4.Clear
   ComboBox5.Clear
   ComboBox6.Clear
   Unload SelPost
End Sub

Private Sub UserForm_Activate()
   Dim WS As Worksheet
   Set WS = ThisWorkbook.Sheets("ALL POSN")
   Dim Tbl As ListObject
   Set Tbl = WS.ListObjects("ALLPOSNS")
   kList = Tbl.DataBodyRange.Value
   Set d = CreateObject("scripting.dictionary")
   
   d.CompareMode = vbTextCompare

   Dim i As Long

   For i = LBound(kList) To UBound(kList)
      d(kList(i, 8)) = Empty
   Next

   ComboBox1.List = d.Keys
   d.RemoveAll
End Sub

Private Sub ComboBox1_Change()

   Dim i As Long

   If Not IsArrow Then
      With ComboBox1
        .ListRows = Application.WorksheetFunction.Min(4, .ListCount)
        .DropDown
        If Len(.Text) Then
          For i = .ListCount - 1 To 0 Step -1
            If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
          Next
          .DropDown
        End If
     End With
   End If

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)

   If (KeyCode = vbKeyReturn Or KeyCode = vbKeyBack) Then
      Dim i As Long
      For i = LBound(kList) To UBound(kList)
         d(kList(i, 8)) = Empty
      Next
      ComboBox1.List = d.Keys
      If Not ComboBox1.ListIndex = -1 Then
          Frame2.Visible = True
      End If
      d.RemoveAll
    End If
End Sub

内容的提问来源于stack exchange，提问作者Chely Jackson