VBA文本框逐词自动补全失效问题求助

当前TextBox的自动补全功能仅对首个输入词生效，输入“ba”能补全为“banana”，但在“banana”后加空格输入第二个词时，补全无法触发，仅支持单个词补全。以下是两段相关VBA代码，需要修复实现逐词补全。

现有代码 #

新代码（TextBoxComm） #

Private Sub TextBoxComm_Change()
Dim lastRow As Long
Dim searchRange As Range
Dim foundCell As Range
Dim chaine, Mot_Proposé As String
Dim word As String 'WORD FAIT OFFICE DE SEArch string

 If m_ignore Then Exit Sub

'Définition du champs de recherche
word = TextBoxComm.text
Set searchRange = ThisWorkbook.Worksheets("Base de données").ListObjects("RCA").ListColumns("Numéro de commande").DataBodyRange

'si c'est vide ne rien faire
If word = "" Then Exit Sub

'Trouve la dernière cellule de la colonne
lastRow = searchRange.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

' Si le mot tapé n'apparaît trouver le mot le plus ressemblant
Set foundCell = searchRange.Find(What:=word & "*", LookIn:=xlValues, LookAt:=xlWhole)

If Not foundCell Is Nothing Then
        'Compléter le mot tapé
        chaine = foundCell.Value
        m_currentSuggestion = Find_Mot(word, chaine)
        TextBoxComm.text = m_currentSuggestion
        
    If Len(m_currentSuggestion) > 0 Then
        m_currentText = m_currentSuggestion
        m_selectionStart = Len(word)
        m_selectionLength = Len(m_currentSuggestion) - Len(word)
        
        TextBoxComm.text = m_currentText
        TextBoxComm.SelStart = m_selectionStart
        TextBoxComm.SelLength = m_selectionLength
        
    End If
    End If
    
   End Sub

初始版本代码（TextBoxMach） #

'Machine
Private Sub TextBoxMach_Change()
Dim lastRow As Long
Dim searchRange As Range
Dim searchString As String
Dim foundCell As Range
Dim chaine, Mot_Proposé As String

 If m_ignore Then Exit Sub

'Définition du champs de recherche
Set searchRange = ThisWorkbook.Worksheets("Base de données").ListObjects("RCA").ListColumns("Type de machine").DataBodyRange
searchString = TextBoxMach.text

'Ne rien faire si le TextBox est vide
If searchString = "" Then Exit Sub

'Trouve la dernière cellule de la colonne
lastRow = searchRange.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Chercher si le mot tapé apparaît déjà dans la colonne
Set foundCell = searchRange.Find(What:=searchString, LookIn:=xlValues, LookAt:=xlWhole)


If Not foundCell Is Nothing Then
    'Si oui, autocomplétion
        
    chaine = foundCell.Value
    Mot_Proposé = Find_Mot(searchString, chaine)
    TextBoxMach.text = Mot_Proposé
    
    TextBoxMach.SelStart = Len(searchString)
    TextBoxMach.SelLength = Len(foundCell.Value) - Len(searchString)
Else
    ' Si le mot tapé n'apparaît trouver le mot le plus ressemblant
    Set foundCell = searchRange.Find(What:=searchString & "*", LookIn:=xlValues, LookAt:=xlWhole)


If Not foundCell Is Nothing Then
        'Compléter le mot tapé
        
        chaine = foundCell.Value
        Mot_Proposé = Find_Mot(searchString, chaine)
        TextBoxMach.text = Mot_Proposé
    
        TextBoxMach.SelStart = Len(searchString)
        TextBoxMach.SelLength = Len(foundCell.Value) - Len(searchString)
End If
End If
End Sub

修复方案 #

核心问题是现有代码将TextBox的全部内容作为搜索词，而非提取最后一个空格之后的文本作为当前待补全的词。修改步骤如下：

1. 拆分TextBox内容，分离已输入的前缀和当前待补全的词
2. 仅用当前待补全的词去搜索匹配项
3. 将补全后的词拼接回前缀，更新TextBox内容
4. 调整选中位置到补全的部分

修改后的TextBoxComm代码 #

Private Sub TextBoxComm_Change()
    Dim lastRow As Long
    Dim searchRange As Range
    Dim foundCell As Range
    Dim chaine As String, m_currentSuggestion As String
    Dim fullText As String, prefix As String, currentWord As String
    Dim spacePos As Integer

    If m_ignore Then Exit Sub

    ' 获取TextBox完整内容
    fullText = TextBoxComm.Text
    If fullText = "" Then Exit Sub

    ' 定义搜索范围
    Set searchRange = ThisWorkbook.Worksheets("Base de données").ListObjects("RCA").ListColumns("Numéro de commande").DataBodyRange

    ' 找到最后一个空格的位置，拆分前缀和当前待补全词
    spacePos = InStrRev(fullText, " ")
    If spacePos > 0 Then
        prefix = Left(fullText, spacePos)
        currentWord = Mid(fullText, spacePos + 1)
    Else
        prefix = ""
        currentWord = fullText
    End If

    ' 仅当当前待补全词非空时执行搜索
    If currentWord = "" Then Exit Sub

    ' 搜索匹配的项（前缀匹配）
    Set foundCell = searchRange.Find(What:=currentWord & "*", LookIn:=xlValues, LookAt:=xlWhole)

    If Not foundCell Is Nothing Then
        chaine = foundCell.Value
        m_currentSuggestion = Find_Mot(currentWord, chaine)
        
        If Len(m_currentSuggestion) > 0 Then
            ' 拼接前缀和补全后的词
            m_currentText = prefix & m_currentSuggestion
            m_selectionStart = Len(prefix & currentWord)
            m_selectionLength = Len(m_currentSuggestion) - Len(currentWord)
            
            m_ignore = True ' 避免触发Change事件循环
            TextBoxComm.Text = m_currentText
            TextBoxComm.SelStart = m_selectionStart
            TextBoxComm.SelLength = m_selectionLength
            m_ignore = False
        End If
    End If
End Sub

修改后的TextBoxMach代码 #

'Machine
Private Sub TextBoxMach_Change()
    Dim lastRow As Long
    Dim searchRange As Range
    Dim foundCell As Range
    Dim chaine As String, Mot_Proposé As String
    Dim fullText As String, prefix As String, currentWord As String
    Dim spacePos As Integer

    If m_ignore Then Exit Sub

    ' 获取TextBox完整内容
    fullText = TextBoxMach.Text
    If fullText = "" Then Exit Sub

    ' 定义搜索范围
    Set searchRange = ThisWorkbook.Worksheets("Base de données").ListObjects("RCA").ListColumns("Type de machine").DataBodyRange

    ' 找到最后一个空格的位置，拆分前缀和当前待补全词
    spacePos = InStrRev(fullText, " ")
    If spacePos > 0 Then
        prefix = Left(fullText, spacePos)
        currentWord = Mid(fullText, spacePos + 1)
    Else
        prefix = ""
        currentWord = fullText
    End If

    ' 仅当当前待补全词非空时执行搜索
    If currentWord = "" Then Exit Sub

    ' 先精确匹配，再前缀匹配
    Set foundCell = searchRange.Find(What:=currentWord, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not foundCell Is Nothing Then
        chaine = foundCell.Value
        Mot_Proposé = Find_Mot(currentWord, chaine)
    Else
        Set foundCell = searchRange.Find(What:=currentWord & "*", LookIn:=xlValues, LookAt:=xlWhole)
        If Not foundCell Is Nothing Then
            chaine = foundCell.Value
            Mot_Proposé = Find_Mot(currentWord, chaine)
        End If
    End If

    If Len(Mot_Proposé) > 0 Then
        ' 拼接前缀和补全后的词
        m_currentText = prefix & Mot_Proposé
        m_selectionStart = Len(prefix & currentWord)
        m_selectionLength = Len(Mot_Proposé) - Len(currentWord)
        
        m_ignore = True ' 避免触发Change事件循环
        TextBoxMach.Text = m_currentText
        TextBoxMach.SelStart = m_selectionStart
        TextBoxMach.SelLength = m_selectionLength
        m_ignore = False
    End If
End Sub

关键修改点说明 #

• 使用InStrRev查找最后一个空格，拆分出已输入的前缀和当前待补全的词
• 仅用当前待补全词进行搜索匹配，而非整个TextBox内容
• 拼接前缀和补全结果，保留之前输入的内容
• 添加m_ignore开关避免修改TextBox内容时触发无限Change事件循环
• 调整选中位置到补全部分，保持原有输入体验

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