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

【问题标题】：How do you remove text from a string in VBA Microsoft Excel如何从 VBA Microsoft Excel 中的字符串中删除文本
【发布时间】：2017-10-02 04:46:25
【问题描述】：

我想在 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

【问题讨论】：

只是另一种方法，如果你喜欢的话......我有一个代码可以将字符串分隔成单词，（用''，空格字符分隔）并返回一个分隔的单词数组，现在如果字符串长度大于 100，我们可以从中创建一个包含所有单词的数组，然后您可以在保持长度计数的同时继续连接它们。
你好像忘记问问题了！
我不确定它是否对你有影响，但它是 Motorola，而不是 Motorolla
您想将所有单元格缩减到 100 个字符或 100 个单词吗？如果单词如果您有一个包含 200 个单词的字符串并且在最后 100 个单词中没有找到要删除的单词会发生什么 - 您仍然想修剪它吗？真正的问题是什么？
@paul bica ，我想将每个单元格修剪为只有 100 个字符，当然单词只有 100 个或更少的字符

标签： string vba excel

【解决方案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

【讨论】：