Excel VBA：如何查找列中包含特定文本的最后单元格

一、基于你当前使用Select的修改版本 #

如果你想继续用Select方法，只需修改查找单元格的逻辑，用Range.Find从下往上搜索，就能定位到符合条件的最后一个单元格：

' 激活源工作簿和工作表
Windows("sheet2.xlsm").Activate
Worksheets("sheet1").Activate

' 从B列底部往上查找第一个匹配项（即最后一个符合条件的单元格）
' 匹配规则：以H开头的单元格（H####格式）
Range("B:B").Find(What:="H*", After:=Range("B1"), LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
    MatchCase:=False).Select

' 复制并粘贴到目标位置
Selection.Copy
Windows("sheet 1").Activate
Range("S1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

参数说明：

• What:="H*"：*是通配符，代表任意多个字符，这里匹配以H开头的单元格内容；如果要找包含H的单元格，改成"*H*"
• SearchDirection:=xlPrevious：从B列最后一行往上搜索，找到的第一个匹配项就是最后一个符合条件的单元格
• LookAt:=xlWhole：匹配整个单元格内容（确保是H开头的完整标识符）；如果是找包含H的单元格，改成xlPart

二、更规范的无Select版本（推荐） #

Select方法容易因工作表切换出错，下面是更稳定的实现，用变量直接引用工作簿/工作表，同时增加了错误判断：

Sub CopyLastMatchingCell()
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim lastMatchCell As Range
    
    ' 指定源数据所在的工作簿和工作表
    Set sourceWB = Workbooks("sheet2.xlsm")
    Set sourceWS = sourceWB.Worksheets("sheet1")
    
    ' 指定目标工作簿和粘贴位置所在工作表
    Set targetWB = Workbooks("sheet 1")
    Set targetWS = targetWB.ActiveSheet ' 也可以指定具体表名，比如targetWB.Worksheets("目标表")
    
    ' 查找B列中最后一个以H开头的单元格
    Set lastMatchCell = sourceWS.Range("B:B").Find(What:="H*", _
        After:=sourceWS.Range("B1"), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False)
    
    ' 找到则复制，没找到则提示
    If Not lastMatchCell Is Nothing Then
        lastMatchCell.Copy targetWS.Range("S1")
    Else
        MsgBox "未找到以H开头的单元格"
    End If
    
    Application.CutCopyMode = False
End Sub

三、扩展到多字母前缀的批量处理 #

如果需要一次性处理H、A、B等多个前缀，可以把查找逻辑封装成通用子过程，重复调用：

' 通用子过程：查找指定前缀的最后单元格并复制到目标位置
Sub CopyLastCellForPrefix(prefix As String, targetRange As Range)
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim lastMatchCell As Range
    
    Set sourceWB = Workbooks("sheet2.xlsm")
    Set sourceWS = sourceWB.Worksheets("sheet1")
    
    Set lastMatchCell = sourceWS.Range("B:B").Find(What:=prefix & "*", _
        After:=sourceWS.Range("B1"), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False)
    
    If Not lastMatchCell Is Nothing Then
        lastMatchCell.Copy targetRange
    Else
        MsgBox "未找到以" & prefix & "开头的单元格"
    End If
End Sub

' 调用示例：批量处理多个前缀
Sub UpdateAllPrefixes()
    CopyLastCellForPrefix "H", Workbooks("sheet 1").Range("S1")
    CopyLastCellForPrefix "A", Workbooks("sheet 1").Range("T1")
    CopyLastCellForPrefix "B", Workbooks("sheet 1").Range("U1")
    CopyLastCellForPrefix "C", Workbooks("sheet 1").Range("V1")
    ' 可继续添加其他前缀和对应目标位置
End Sub

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