刪除 excel 列的每個單元格中的特定單詞列表

Question

在 excel 列 (A) 的每個單元格中，我有一組要刪除的單詞

list_remove = ["en", "la, "con", "una", "uno", "&", "-", ",", "para", "de", "del]

例如，如果單元格是：

Soporte para computadora en la pared

我只希望最終的單元格將 output 像這樣

Soporte computadora pared

但我希望如果這些單詞包含在不被刪除的字符串中

例如：

Edredon para cama king queen

我不想要這樣的單元格結果

Edredon cama king que

相反，我想要這個:)

Edredon cama king queen

我怎么能這樣做？ 提前致謝：）

Answer 1

下次記得添加你到目前為止所做的代碼。

如果我理解您的問題，您可以使用以下步驟：

要檢查的單詞在 A 列中。

我的步驟：

0.聲明我需要的變量

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. 初始化 remove_list 數組：

    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.我數一下A列有多少行：

numRows = Cells(Rows.count, "A").End(xlUp).Row

3.初始化ok變量為false

ok=false

4.我用了3個for循環。 第一個使用索引 k 循環工作表中的行。 第二個循環檢查拆分的句子，最后一個循環用 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

完整代碼如下：

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

工作表示例

初始表

最終結果

Answer 2

刪除字符和單詞

• 刪除字符和刪除單詞是有區別的。
• 在運行前調整removeWordsAndChars的常量部分中的值。

編碼

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

我認為您可以使用兩個用戶定義的函數。

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