I have an array of words I want to remove in each cell of an excel column (A)
list_remove = ["en", "la, "con", "una", "uno", "&", "-", ",", "para", "de", "del]
For example if the cell is:
Soporte para computadora en la pared
I just want that the final cell will output something like this
Soporte computadora pared
But I want that if these words are included in an string not to be removed
For example:
Edredon para cama king queen
I don't want that cell result like this
Edredon cama king que
Instead I want this:)
Edredon cama king queen
How could I do this? Thanks in advance:)
Next time remember to add the code you made so far.
if i understand your question, you can use this steps:
The words to check are in column A.
My steps:
0. declare the variables that i need
Dim list_remove(10) As String '["en", "la, "con", "una", "uno", "&", "-", ",", "para", "de", "del]
Dim sentence_list() As String ' array where we get the single words
Dim count As Integer ' number of words that there are into cell
Dim i, j, k, numRows As Integer ' indexs
Dim final_word As String ' final words
Dim ok As Boolean ' check word if there is in the list_remove
initialize the remove_list array:
list_remove(0) = "en" list_remove(1) = "la" list_remove(2) = "con" list_remove(3) = "una" list_remove(4) = "uno" list_remove(5) = "&" list_remove(6) = "-" list_remove(7) = "," list_remove(8) = "para" list_remove(9) = "de" list_remove(10) = "del"
2. I count how many rows there are in column A:
numRows = Cells(Rows.count, "A").End(xlUp).Row
3. Initialize ok variable to false
ok=false
4.I used 3 for loops. 1st with index k to loop the rows in the sheet. 2nd loop to check the splitted sentence and the final loop to check the single word with the list_remove.
For k = 1 To numRows
sentence_list = Split(Cells(k, 1), " ") ' split the sentence foreach cell in COLUMN A
count = UBound(sentence_list) ' count numbers of words splitted
final_word = "" ' initialize the final_words
For i = 0 To count
For j = 0 To 10
'check the word splitted if there is into list_remove
If sentence_list(i) = list_remove(j) Then
ok = True
Exit For
End If
Next j
If ok = False Then
final_word = final_word + " " + sentence_list(i) ' good word
End If
ok = False
Next i
Cells(k, 1) = final_word ' I put the final words into cell checked
Next k
The complete code is the following:
sub removeWords()
Dim list_remove(10) As String '["en", "la, "con", "una", "uno", "&", "-", ",", "para", "de", "del]
Dim sentence_list() As String ' array where we get the single words
Dim count As Integer ' number of words that there are into cell
Dim i, j, k, numRows As Integer ' indexs
Dim final_word As String ' final words
Dim ok As Boolean ' check word if there is in the list_remove
list_remove(0) = "en"
list_remove(1) = "la"
list_remove(2) = "con"
list_remove(3) = "una"
list_remove(4) = "uno"
list_remove(5) = "&"
list_remove(6) = "-"
list_remove(7) = ","
list_remove(8) = "para"
list_remove(9) = "de"
list_remove(10) = "del"
numRows = Cells(Rows.count, "A").End(xlUp).Row
ok=false
For k = 1 To numRows
sentence_list = Split(Cells(k, 1), " ") ' split the sentence foreach cell in COLUMN A
count = UBound(sentence_list) ' count numbers of words splitted
final_word = "" ' initialize the final_words
For i = 0 To count
For j = 0 To 10
'check the word splitted if there is into list_remove
If sentence_list(i) = list_remove(j) Then
ok = True
Exit For
End If
Next j
If ok = False Then
final_word = final_word + " " + sentence_list(i) ' good word
End If
ok = False
Next i
Cells(k, 1) = final_word ' I put the final words into cell checked
Next k
end sub
Sheet example
Initial sheet
the final result
removeWordsAndChars
before running it.The Code
Option Explicit
Sub removeWordsAndChars()
Const WordDelimiter As String = ","
Const WordList As String = "en,la,con,una,uno,para,de,del"
Const CharDelimiter As String = "|"
Const CharList As String = ".|,|:|;|-|_|?|!|""|'|`|&|(|)"
Const wsName As String = "Sheet1"
Const FirstCell As String = "A2"
Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
Dim rng As Range
Set rng = defineNonEmptyColumnRange(wb.Worksheets(wsName).Range(FirstCell))
If Not rng Is Nothing Then
Dim Data As Variant: Data = getColumnRange(rng)
Dim cString As String
Dim i As Long
For i = 1 To UBound(Data, 1)
If VarType(Data(i, 1)) = vbString Then
cString = Data(i, 1)
If Len(cString) > 0 Then
cString = removeChars(cString, CharList, CharDelimiter)
cString = removeWords(cString, WordList, WordDelimiter)
End If
End If
Next i
rng.Value = Data
End If
End Sub
Function defineNonEmptyColumnRange( _
FirstCellRange As Range) _
As Range
If Not FirstCellRange Is Nothing Then
Dim cel As Range
With FirstCellRange
Set cel = .Resize(.Worksheet.Rows.Count - .Row + 1).Find( _
What:="*", _
LookIn:=xlFormulas, _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
Set defineNonEmptyColumnRange = .Resize(cel.Row - .Row + 1)
End If
End With
End If
End Function
Function getColumnRange( _
rng As Range) _
As Variant
If Not rng Is Nothing Then
Dim Data As Variant
If rng.Rows.Count > 1 Then
Data = rng.Value
Else
ReDim Data(1 To 1, 1 To 1)
Data(1, 1) = rng.Value
End If
getColumnRange = Data
End If
End Function
Function removeChars( _
ByVal s As String, _
ByVal CharList As String, _
ByVal Delimiter As String, _
Optional ByVal CompareMethod As VbCompareMethod = vbTextCompare, _
Optional ByVal removeRedundantSpaces As Boolean = True) _
As String
Dim Chars() As String: Chars = Split(CharList, Delimiter)
removeChars = s
Dim n As Long
For n = 0 To UBound(Chars)
removeChars = Replace(removeChars, Chars(n), " ", , , CompareMethod)
Next
If removeRedundantSpaces Then
removeChars = WorksheetFunction.Trim(removeChars)
End If
End Function
Function removeWords( _
ByVal s As String, _
ByVal WordList As String, _
Optional ByVal Delimiter As String = ",", _
Optional ByVal CompareMethod As VbCompareMethod = vbTextCompare, _
Optional ByVal removeRedundantSpaces As Boolean = True) _
As String
Dim Words() As String: Words = Split(WordList, Delimiter)
Dim Source() As String: Source = Split(s, " ")
Dim cMatch As Variant
Dim n As Long
Select Case CompareMethod
Case vbTextCompare
cMatch = Application.Match(Source, Words, 0)
For n = 1 To UBound(cMatch)
If IsNumeric(cMatch(n)) Then
Source(n - 1) = ""
End If
Next n
Case vbBinaryCompare
For n = 0 To UBound(Source)
cMatch = Application.Match(Source(n), Words, 0)
If IsNumeric(cMatch) Then
If StrComp(Source(n), Words(cMatch - 1), _
vbBinaryCompare) = 0 Then
Source(n) = ""
End If
End If
Next n
End Select
removeWords = Join(Source, " ")
If removeRedundantSpaces Then
removeWords = WorksheetFunction.Trim(removeWords)
End If
End Function
Sub TESTremove()
Const WordList As String = "en,la,con,una,uno,para,de,del"
Const CharList As String = ".|,|:|;|-|_|?|!|""|'|`|&"
Dim s As String
s = "Soporte para computadora en la pared"
Debug.Print removeWords(s, WordList, ",")
' Result: 'Soporte computadora pared'
s = "Edredonuna?! ""en para"".. cama, king ,,, uno - - queen ??"
Debug.Print removeWords(removeChars(s, CharList, "|"), WordList, ",")
' Result: 'Edredonuna cama king queen'
End Sub
I think you can use two user-defined functions.
Sub test()
Dim s As String
Dim sResult As String
s = "Edredon para cama king queen"
's = "Soporte para computadora en la pared"
sResult = getRemove(s)
Range("a1") = sResult
End Sub
Function getRemove(s As String)
Dim arr As Variant, vR() As Variant
Dim n As Integer, a As Variant
arr = Split(s)
For Each a In arr
If isExist(a) Then
Else
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = a
End If
Next a
If n Then
getRemove = Join(vR)
End If
End Function
Function isExist(v As Variant) As Boolean
Dim list_remove As Variant
Dim a As Variant
list_remove = Array("en", "la", "con", "una", "uno", "&", "-", ",", "para", "de", "del")
For Each a In list_remove
If v = a Then
isExist = True
Exit Function
End If
Next a
isExist = False
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.