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

我想将MS Excel中的每个单元格中的字符串修剪为具有500个单元格的列中的100个字符。如何从VBA中的字符串中删除文本Microsoft Excel

从第一个单元格开始，检查字符串长度是否等于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

来源

2017-09-25 Kamotho

只是另一种方法，如果你喜欢它......我有一个代码分离一个字符串转换成单词（用''，空格字符分隔）并返回一个分隔的单词数组，现在如果字符串长度超过100，我们可以将所有单词排成一个数组，然后您可以将它们连接起来同时保持长度的计数.. –

你似乎忘记了问任务离子！ – SJR

我不确定它是否会对您有所帮助，但它是'摩托罗拉'，而不是'摩托罗拉' – Moacir

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

来源

2017-09-26 18:04:21 Kamotho

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

回答

相关问题