どのように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