修剪符合特定条件的Excel单元格

嗨

如果特定单元格以直接贷记开头，我需要修剪前21个字符？ 在我的代码中有错误，如果。。。

---

有人能帮忙吗？

看看这是否有用。如果是，请将答案标记为已回答

Private Sub CommandButton22_Click()
row_number = 6
Do
DoEvents
    row_number = row_number + 1
    item_description = ActiveSheet.Range("B" & row_number)
        If InStr(item_description, "Direct Credit") > 0 Then
        item_description = ActiveCell.Activate
        ActiveCell.Value = Right(ActiveCell, Len(ActiveCell) - 21)
        End If
Loop Until item_description = B1000

End Sub

---

通常，除了简单的代码外，还应该包含一些解释代码如何回答问题或解决问题的文本。

Public Sub MyTrim()
Const STARTS_WITH_STR As String = "Direct Credit"
Const TRIM_NUM As Integer = 21

Dim sht As Worksheet
Dim range As range
Dim cell As range
Dim sText As String
Dim iPos As Integer
Dim i As Integer

Set sht = ActiveSheet

' loop for 1000 rows
For i = 1 To 1000
    ' for each row, get the cell in column "B"
    Set cell = sht.Cells(i, "B")
    ' get the text of the cell with triming blanks on both side of the string
    sText = Trim(cell.Text)

    ' Search for a sub string. It does a text based compare (vbTextCompare)
    ' meaning- it will look for "Direct Credit" and also for "DIRECT CREDIT" and
    ' every thing in between (for example: DIREct Credit, .....)
    iPost = InStr(1, sText, STARTS_WITH_STR, vbTextCompare)

    ' if the cell starts with the sub string above
    If (iPos = 1) Then
        ' remove the 21 first chars
        sText = Mid(sText, TRIM_NUM + 1)
        cell.Value = sText
    End If
Next
End Sub

Private Sub CommandButton23_Click()
Dim c As Range
     For Each c In Range("B6:B1200")
         With c
             If Left(.Value, 13) = "Direct Credit" Then .Value = Right(.Value, Len(.Value) - 21)
         End With
     Next c

End Sub