删除特定字符后的string

我发现下面的function ,将删除指定的字符之前的任何字符。

不过,我想让它删除指定字符后面的所有字符。

请你能帮我做到这一点。

Sub RemoveAllButLastWord() 'Updateby20140612 Dim Rng As Range Dim WorkRng As Range Dim xChar As String On Error Resume Next xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) xChar = Application.InputBox("String", xTitleId, "", Type:=2) For Each Rng In WorkRng xValue = Rng.Value Rng.Value = VBA.Right(xValue, VBA.Len(xValue) - VBA.InStrRev(xValue, xChar)) Next End Sub 

我不明白你所提供的代码中发生的一切,但对我来说似乎过于复杂。 如果我正确地理解了你,你想遍历一个范围内的每个单元格,并且删除特定字符之后出现的单元格中的所有内容。 这是我将如何做到这一点:

 Sub RemoveAllTextAfterChar() Dim rWorkRange As Range Dim rng As Range Dim sChar As String Dim sOldValue As String Dim sNewValue As String Dim dCharNumber As Double Set rWorkRange = ActiveSheet.Selection sChar = InputBox("Enter the character") For Each rng In rWorkRange sOldValue = rng.value 'Get cell value into a variable dCharNumber = InStr(sOldValue, sChar) 'Use InStr function to find where the special character occurs If Not dCharNumber = 0 Then 'If character does not occur, do not change the cell sNewValue = Mid(sOldValue, 1, dCharNumber) 'Create a new string that cuts off at the special character rng.value = sNewValue 'Replace original cell value with new, edited value End If Next Set rWorkRange = Nothing Set rng = Nothing End Sub 

像这样的东西

我已经收紧了原来的代码

 Sub RemoveAllFirstLastWord() Dim Rng As Range Dim WorkRng As Range Dim xChar As String Dim lngPos As Long Set WorkRng = Application.InputBox("Range", "KutoolsforExcel", Selection.Address, Type:=8) xChar = Application.InputBox("String", xTitleId, "", Type:=2) For Each Rng In WorkRng lngPos = InStr(Rng.Value, xChar) If lngPos > 0 Then Rng.Offset(0, 1).Value = Left$(Rng.Value, lngPos - 1) Next End Sub