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

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

我想在MS Excel中将每个单元格中的字符串修剪为包含500个单元格的列中的100个字符。

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.

从第一个单元格开始，检查字符串长度是否等于100个字符。如果单词超过100，则删除单元格中的1个单词，然后再次检查，如果超过100则删除另一个单词，直到该字符串小于100.然后将少于100个字符的字符串粘贴到同一个单元格中超过100个字符串。

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

1 个解决方案

#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