符合特定条件的

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 

嗨修剪Excel单元格，

我需要修剪前21个字符，如果特定的细胞与“直接信贷”开始？
我的代码在“Then”之后出现了错误If ...
Can Some one help please please？

Answer 1

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 

Answer 2

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

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