删除 excel 列的每个单元格中的特定单词列表

Question

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:)

Answer 1

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

1. 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

Answer 2

Remove Chars and Words

• There is a difference between removing characters and removing words.
• Adjust the values in the constants section of 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

Answer 3

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