![](/img/trans.png)
[英]How do you Highlight text programmatically in Word from Excel with VBA?
[英]How do you remove text from a string in VBA Microsoft Excel
我想在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
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.