Excel VBA按表头定位列 批量移除图片文件名扩展名实现方法

你写的代码有两个明显问题：

• 替换规则仅匹配*.png，只能处理png格式后缀，jpg、gif等其他扩展名完全没覆盖，而且固定写死列B的引用，只要列位置变动代码就会跑错
• 直接用通配符替换的逻辑如果没处理好，很容易误删文件名本身包含的.字符后的内容

通过表头动态定位目标列，同时兼容所有扩展名格式，不会误删文件名内自带的点：

Sub RemoveFileExtensions()
    Dim ws As Worksheet
    Dim targetCol As Long
    Dim lastDataRow As Long
    Dim i As Long
    
    Set ws = ThisWorkbook.Sheets("AMP Sheet")
    
    ' 动态定位表头为Name的列
    On Error Resume Next
    targetCol = ws.Rows(1).Find(What:="Name", LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0
    If targetCol = 0 Then
        MsgBox "表头不存在Name列，请检查表格"
        Exit Sub
    End If
    
    ' 定位该列最后一行有效数据
    lastDataRow = ws.Cells(ws.Rows.Count, targetCol).End(xlUp).Row
    
    ' 逐行处理，跳过表头行
    For i = 2 To lastDataRow
        Dim cellVal As String
        cellVal = ws.Cells(i, targetCol).Value
        If InStrRev(cellVal, ".") > 0 Then
            ' 从右往左找最后一个点的位置，截取前面的内容，兼容文件名带点的场景（比如my.banana.png会正确得到my.banana）
            ws.Cells(i, targetCol).Value = Left(cellVal, InStrRev(cellVal, ".") - 1)
        End If
    Next i
End Sub

如果你确认所有文件名本身不会包含.字符，只有扩展名前有一个点，可以直接用批量替换代替逐行循环，处理大表格速度更快：

' 把上面代码里的For循环部分替换成这段即可
ws.Columns(targetCol).Replace What:=".*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False

注意这个写法会把单元格里第一个.之后的所有内容全部清空，文件名本身带点的场景不要用。

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