从一列的整个文本中删除某些字符



我有一个名为" AMP sheet "的表单。B1的列标题为"名称"。在该列下,我有带有图像扩展名的图像名称。

例如:

Name  
banana.png  
pear.jpg  
apple.gif  
etc.

我正在尝试删除名称列中图像的扩展名。

我正在寻找的最终结果:

Name  
banana  
pear  
apple  
etc.

这是我想出来的:

With Sheets("AMP Sheet")
Columns("B:B").Replace what:="*.png*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlRows
End With

这个逻辑不能正常工作。

另外,我想通过标题名称来标识列,而不是使用Columns("B:B"),例如column (" name ")。

删除列中文件名中的文件扩展名

Option Explicit
Sub RemoveFileExtensions()
Const wsName As String = "AMP Sheet"
Const Header As String = "Name"
Const HeaderRow As Long = 1

Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)

Dim hCol As Variant: hCol = Application.Match(Header, ws.Rows(HeaderRow), 0)
If IsError(hCol) Then
MsgBox "Column '" & Header & "' not found.", vbCritical
Exit Sub
End If

Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, hCol).End(xlUp).Row
If lRow <= HeaderRow Then
MsgBox "No data in column '" & Header & "'.", vbCritical
Exit Sub
End If

Dim rg As Range
Set rg = ws.Range(ws.Cells(HeaderRow, hCol), ws.Cells(lRow, hCol))

Dim Data As Variant: Data = rg.Value

Dim r As Long
Dim DotPosition As Long
Dim CurrentString As String

For r = 2 To UBound(Data, 1)
CurrentString = CStr(Data(r, 1))
DotPosition = InStrRev(CurrentString, ".")
If DotPosition > 0 Then ' found a dot
Data(r, 1) = Left(CurrentString, DotPosition - 1)
'Else ' found no dot; do nothing
End If
Next r

rg.Value = Data

MsgBox "File extensions removed.", vbInformation

End Sub

这就是我最终创建的内容,它在我的用例中工作得很好。谢谢大家的帮助,我希望这能帮助到你们!

Sub RemoveImageExtensions()
Dim sht As Worksheet
Dim fndpng As Variant
Dim rplc As Variant
fndpng = ".png"
rplc = ""
'Store a specfic sheet to a variable
Set sht = ActiveWorkbook.Worksheets("AMP Sheet")
'Perform the Find/Replace All - .png'
sht.Cells.Replace what:=fndpng, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
End Sub

最新更新