Question

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

您好，

如果特定单元格以＆＃34;直接信用＆＃34;？来开始，我需要修剪前21个字符我的编码在＆＃34;然后＆＃34;之后出现了问题。如果...
有人可以帮忙吗？

Answer 1

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

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

Answer 2

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

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

2 个答案: