在表格上检索数据

宏

需求

我希望可以自动匹配数据，我现在有一个数据表Sheet2，首行是标题，现在我需要在Sheet3首行指定要检索的Sheet2要匹配内容的标题，比方Sheet2包含顾客ID、姓名两列数据，我只需要在Sheet3首行填入顾客ID、姓名，然后在对应标题列下面输入内容就会模糊匹配完整顾客ID并显示相应“姓名”内容，然后我可以一个个输入匹配，不需要去反复清除内容。

结果

在Sheet3中输入部分顾客ID后，能够自动模糊匹配Sheet2中的完整顾客ID，并显示对应的姓名。我们可以通过编写一个VBA脚本来实现这个功能。以下是一个示例脚本，它会在Sheet3中输入内容时自动进行匹配：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet2") ' 替换为您的源数据表格名称
    Set wsTarget = Me ' 目标表格就是当前表格
    
    Dim lastRowSource As Long
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
    Dim colIndex As Long
    colIndex = Target.Column
    
    If colIndex > 1 Then Exit Sub ' 假设第一列是顾客ID
    
    Dim searchValue As String
    searchValue = Target.Value
    
    Dim matchFound As Boolean
    matchFound = False
    
    Dim i As Long
    For i = 2 To lastRowSource
        If InStr(1, wsSource.Cells(i, 1).Value, searchValue, vbTextCompare) > 0 Then
            wsTarget.Cells(Target.Row, 2).Value = wsSource.Cells(i, 2).Value ' 假设第二列是姓名
            matchFound = True
            Exit For
        End If
    Next i
    
    If Not matchFound Then
        wsTarget.Cells(Target.Row, 2).Value = "未找到匹配项"
    End If
End Sub

使用方法：

1. 将上述代码粘贴到Sheet3的代码窗口中。您可以通过右键点击Sheet3标签，选择“查看代码”来打开VBA编辑器。（这里的sheet3不是指名称，而是本质）
2. 确保Sheet2和Sheet3的列标题和数据格式正确。
3. 在Sheet3的第一列（顾客ID列）输入部分顾客ID，脚本会自动在Sheet2中进行模糊匹配，并在Sheet3的第二列（姓名列）显示匹配结果。

调试步骤：

1. 添加调试信息：
   • 在代码中添加一些调试信息，例如 MsgBox，以帮助您了解代码执行到哪一步。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet2") ' 替换为您的源数据表格名称
    Set wsTarget = Me ' 目标表格就是当前表格
    
    Dim lastRowSource As Long
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
    Dim colIndex As Long
    colIndex = Target.Column
    
    If colIndex > 1 Then Exit Sub ' 假设第一列是顾客ID
    
    Dim searchValue As String
    searchValue = Target.Value
    
    Dim matchFound As Boolean
    matchFound = False
    
    Dim i As Long
    For i = 2 To lastRowSource
        If InStr(1, wsSource.Cells(i, 1).Value, searchValue, vbTextCompare) > 0 Then
            wsTarget.Cells(Target.Row, 2).Value = wsSource.Cells(i, 2).Value ' 假设第二列是姓名
            matchFound = True
            Exit For
        End If
    Next i
    
    If Not matchFound Then
        wsTarget.Cells(Target.Row, 2).Value = "未找到匹配项"
    End If
    
    ' 添加调试信息
    MsgBox "搜索值: " & searchValue & vbCrLf & "匹配结果: " & wsTarget.Cells(Target.Row, 2).Value
End Sub

通过添加调试信息，您可以查看每次输入内容时搜索值和匹配结果，从而帮助您定位问题。

问题

如果有多个匹配结果呢？