如何從VBA Microsoft Excel中的字符串中刪除文本

Question

我想在MS Excel中將每個單元格中的字符串修剪為包含500個單元格的列中的100個字符。

從第一個單元格開始，檢查字符串長度是否等於或等於100個字符。 如果單詞多於100，則刪除單元格中的1個單詞，然后再次檢查，如果單詞多於100，則刪除另一個單詞，直到字符串小於100。然后將少於100個字符串粘貼到同一單元格中，以替換先前的單詞。超過100個字符串。

然后移到另一個單元格並補充上一步。

要刪除的單詞在數組中

到目前為止，這是我的代碼

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