如何从VBA Microsoft Excel中的字符串中删除文本

Question

I want to trim a string in MS Excel each cell to 100 characters in a column with 500 cells.

Starting with first cell, check if string length is or equal 100 characters. If the words are more than 100, then remove 1 word in the cell, then check again, if it's more than 100 remove another word until the string is less to 100. Then paste the less than 100 character string into the same cell replacing previous more than 100 character string.

Then move to another cell and replete the previous step.

The words to be removed are in an array

Here is my code so far

Sub RemoveWords()
Dim i As Long
Dim cellValue As String
Dim stringLenth As Long
Dim myString As String
Dim words() As Variant
words = Array("Many", "specific ", "Huawei", "tend", "Motorolla", "Apple")

myString = "Biggest problem with many phone reviews from non-tech specific publications is that its reviewers tend to judge the phones in a vacuum"
For i = 1 To 13
cellValue = Cells(i, 4).Value
        If Not IsEmpty(cellValue) Then
            stringLength = Len(cellValue)
            ' test if string is less than 100
            If stringLength > 100 Then
                Call replaceWords(cellValue, stringLength, words)
            Else
               ' MsgBox "less than 100 "
            End If
        End If          
    Next i

End Sub

Public Sub replaceWords(cellValue, stringLength, words)
    Dim wordToRemove As Variant
    Dim i As Long
    Dim endString As String
    Dim cellPosition As Variant

    i = 0

    If stringLength > 100 Then

        For Each wordToRemove In words
            If InStr(1, UCase(cellValue), UCase(wordToRemove )) = 1 Then
            MsgBox "worked word found" & " -- " & cellValue & " -- " & key
            Else
            Debug.Print "Nothing worked" & " -- " & cellValue & " -- " & key

            End If
        Next wordToRemove 
     Else
     MsgBox "less than 100 "
    End If

End Sub

Answer 1

Sub NonKeyWords()
' remove non key words
'

Dim i As Long
Dim cellValue As String
Dim stringLenth As Long
Dim wordToRemove  As Variant
Dim words() As Variant
Dim item As Variant

' assign non-key words to array
words = words = Array("Many", "specific ", "Huawei", "tend", "Motorolla", "Apple")

' loop though all cells in column D
For i = 2 To 2000
cellValue = Cells(i, 4).Value
    If Not IsEmpty(cellValue) Then
        ' test if string is less than 100
        If Len(cellValue) > 100 Then
        'Debug.Print "BEFORE REMOVING: " & cellValue
            Call replaceWords(cellValue, words, i)
        Else
           ' MsgBox "less than 100"
        End If
    End If
Next i

End Sub

Public Sub replaceWords(cellValue, words, i)

If Len(cellValue) > 100 Then

        For Each wordsToDelete In words
           If Len(cellValue) > 100 Then
            cellValue = Replace(cellValue, wordsToDelete, "")
            'Debug.Print cellValue
            Debug.Print "String length after removal = " & Len(cellValue)
            Debug.Print "remove another word................"
            'cells(i, 4).ClearContents
            Cells(i, 4).Value = cellValue
            Else
            'exit
            End If
        Next
 Else
    Debug.Print "SAVE: " & cellValue

End If

End Sub