Excel VBA ComboBox显示文本与Text属性值不符异常排查

异常表现 #

基于VBA实现ComboBox联动展示当前选中单元格文本的功能时，控件出现显示异常，具体特征如下：

• ComboBox的Text属性返回值与目标单元格文本一致，为正确值，但控件界面实际显示上一次选中的旧值
• 异常触发时Excel的ScreenUpdating属性为True
• 出现异常的ComboBox始终处于启用状态
• 异常所在工作表内仅存在这1个ComboBox控件，无其他对象、形状、按钮或窗体，工作表内仅包含1个ListObject表格
• 同工作簿内另外2个工作表的ComboBox采用完全一致的显隐、单元格值绑定逻辑，运行无异常；仅LinhKien工作表中的ComboBox存在该显示问题

控件运行规则 #

该ComboBox的显隐、值绑定逻辑如下：

• 当用户选中区域包含多个单元格、或选中区域不在第1列时，控件自动隐藏
• 当用户选中第1列第3行以下的单个单元格，且单元格属于工作表内的表格范围时，控件自动显示，同步移动到对应单元格位置，绑定展示目标单元格的文本

相关实现代码 #

工作表选中事件响应代码 #

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
DoEvents
If Selection.Count > 1 Then Exit Sub
If Application.CutCopyMode Then
    searchBoxAccessories.Visible = False
    Exit Sub
End If

If searchBoxAccessories Is Nothing Then
    Set searchBoxAccessories = ActiveSheet.OLEObjects("SearchCombBoxAccessories")
End If


If Target.Column = 1 And Target.Row > 3 Then
    Dim isect As Range
    Set isect = Application.Intersect(Target, ListObjects(1).Range)
    If isect Is Nothing Then GoTo DoNothing
    isInitializingComboBox = True
    GetSearchAccessoriesData
    searchBoxAccessories.Activate
    
    isInitializingComboBox = True ' 阻止控件属性修改时触发Change事件
    searchBoxAccessories.Top = Target.Top
    searchBoxAccessories.Left = Target.Left
    searchBoxAccessories.Width = Target.Width + 15
    searchBoxAccessories.Height = Target.Height + 2
    Application.EnableEvents = False ' 另一个阻止Change事件触发的处理
    searchBoxAccessories.Object.text = Target.text
    Application.EnableEvents = True
    searchBoxAccessories.Object.SelStart = 0
    searchBoxAccessories.Object.SelLength = Len(Target.text)
    searchBoxAccessories.Visible = True
    isInitializingComboBox = False ' 异常截图拍摄于该代码行位置
    Set workingCell = Target
Else
DoNothing:

    If searchBoxAccessories Is Nothing Then
        Set searchBoxAccessories = ActiveSheet.OLEObjects("SearchCombBoxAccessories")
    End If
    
    If searchBoxAccessories.Visible Then searchBoxAccessories.Visible = False
End If

End Sub

下拉数据源加载过程 #

Public Sub GetSearchAccessoriesData()

Dim col2Get As String: col2Get = "3;4;5;6"
Dim dataSourceRg As Range: Set dataSourceRg = GetTableRange("PhuKienTbl")
If Not IsEmptyArray(searchAccessoriesArr) Then Erase searchAccessoriesArr
searchAccessoriesArr = GetSearchData(col2Get, dataSourceRg, Sheet22.SearchCombBoxAccessories)

End Sub

下拉控件数据源配置函数 #

Public Function GetSearchData(col2Get As String, dataSourceRg As Range, searchComboBox As ComboBox, _
Optional filterMat As String = "") As Variant

Dim filterStr As String: filterStr = IIf(filterMat = "", ";", "1;" & filterMat)
Dim colVisible As Integer: colVisible = 1
Dim colsWidth As String: colsWidth = "200"
Dim isHeader As Boolean
Dim colCount As Integer: colCount = Len(col2Get) - Len(Replace(col2Get, ";", "")) + 1
GetSearchData = GetArrFromRange(dataSourceRg, col2Get, False, filterStr)

With searchComboBox
    .ColumnCount = colVisible
    .ColumnWidths = colsWidth
    .ColumnHeads = False
End With
Set dataSourceRg = Nothing

End Function

单元格区域转数组工具函数 #

Public Function GetArrFromRange(rg As Range, cols2GetStr As String, isHeader As Boolean, Optional colCriFilterStr As String = ";") As Variant

Dim col2Get As Variant: col2Get = Split(cols2GetStr, ";")
Dim arrRowsCount As Integer
Dim arrColsCount As Integer: arrColsCount = UBound(col2Get) + 1
Dim resultArr() As Variant
Dim iRow As Integer
Dim iCol As Integer
Dim criCol As Integer
If Len(colCriFilterStr) = 1 Then
    criCol = 0
Else:  criCol = CInt(Left(colCriFilterStr, InStr(colCriFilterStr, ";") - 1))
End If
Dim criStr As String: criStr = IIf(isHeader, "", Mid(colCriFilterStr, InStr(colCriFilterStr, ";") + 1))

If isHeader Then
    arrRowsCount = 1
Else
    If criCol <> 0 Then
        arrRowsCount = WorksheetFunction.CountIf(rg.Columns(criCol), criStr)
    Else
        arrRowsCount = rg.Rows.Count
    End If
End If
If arrRowsCount = 0 Then GoTo EndOfFunction
ReDim resultArr(1 To arrRowsCount, 1 To arrColsCount)
Dim wkCell As Range
Dim arrRow As Integer: arrRow = 1
For iRow = IIf(isHeader, 1, 2) To IIf(isHeader, 1, rg.Rows.Count)
    If criStr = "" Then
        For iCol = 1 To arrColsCount
            resultArr(arrRow, iCol) = rg.Cells(iRow, CDbl(col2Get(iCol - 1))).Value
        Next iCol
        arrRow = arrRow + 1
    Else
        If rg.Cells(iRow, criCol).Value = criStr Then
            For iCol = 1 To arrColsCount
                resultArr(arrRow, iCol) = rg.Cells(iRow, CDbl(col2Get(iCol - 1))).Value
            Next iCol
            arrRow = arrRow + 1
        End If
    End If
Next iRow
EndOfFunction:
GetArrFromRange = resultArr
Erase resultArr
End Function

内容的提问来源于stack exchange，提问作者Tam Le