Question

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

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

然后移动到另一个单元格并重新完成上一步。

要删除的单词是数组

到目前为止，这是我的代码

fs.readFile

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

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

1 个答案: