Question

我想从逗号分隔的多个单词中删除单个单词：

我想要一个适用于工作簿中所有工作表的宏。

我在Sheet1，Sheet2，Sheet3的A列中有以下数据。对于不同的工作表，行数和数据的数量不同。

Little Nicobar
Mildera
Mus
Nancowrie
Nehrugram
Pilomilo Island

并在Q列中跟随数据：

Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island

希望列R中的输出如下：

Mildera,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mus,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Nancowrie,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nehrugram,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Pilomilo Island
Little Nicobar,Mildera,Mus,Nancowrie,Nehrugram

表示我想从列R中删除A列中的单词。

为此，我们可以使用R1中的公式

=TRIM(SUBSTITUTE(Q1,A1,""))

但它只适用于R1。

我想要一个提供所需输出的宏，并且应该适用于所有工作表。由于Sheet1，sheet2 ... sheetn中存在不同的数据。帮助我。

Answer 1

在R1中编写此公式并向下拖动

=SUBSTITUTE(Q1,","&A1,"")

Answer 2

我觉得这对于excel函数肯定是可能的，因为VB看起来有点矫枉过正。这会将col字符串中的大字符串放入数组中，并删除col A中的任何值。请参阅下面的答案，如果您有任何问题，请告诉我。这也是假设您的数据没有标题。

Sub ReplaceThings()

    Dim wbk As Workbook
    Dim wksht As Worksheet
    Dim RemoveMe As String, myList() As String, myText As String
    Dim Cell As Range
    Dim x As Long, lRow As Long, p As Long

    Set wbk = Workbooks("StackOverflow.xlsm") 'Change this to your workbook name

    'Loop through each worksheet in workbook
    For Each wksht In wbk.Worksheets
        With wksht
            'Find last row
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
            For Each Cell In .Range("A1:A" & lRow)
                RemoveMe = Cell.Value
                'Fill array with data in Column Q
                myList = Split(Cell.Offset(0, 16).Value, ",")
                For x = LBound(myList) To UBound(myList)
                    'Loop through array and check if RemoveMe is in Array
                    If myList(x) = RemoveMe Then
                        'Remove value from array
                        For p = x To UBound(myList) - 1
                            myList(p) = myList(p + 1)
                        Next p
                        Exit For
                    End If
                Next x
                'Print value to column Q
                For x = LBound(myList) To UBound(myList)
                    If x = 0 Then
                        myText = myText & myList(x)
                    Else
                        myText = myText & "," & myList(x)
                    End If
                Next x
                Cell.Offset(0, 17) = myText
                myText = ""
                Erase myList
            Next Cell
        End With
    Next wksht

End Sub

Answer 3

试试这个

Sub test()
    Dim vDB, vData, vR()
    Dim s As String
    Dim Ws As Worksheet
    Dim i As Long, n As Long
    For Each Ws In Worksheets
        With Ws
            vDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
            n = UBound(vDB, 1)
            vData = .Range("q1").Resize(n)
            ReDim vR(1 To n, 1 To 1)
            For i = 1 To n
                s = Replace(vData(i, 1), vDB(i, 1), "")
                s = Replace(s, ",,", ",")
                If Left(s, 1) = "," Then
                    Mid(s, 1, 1) = Space(1)
                End If
                If Right(s, 1) = "," Then
                    Mid(s, Len(s), 1) = Space(1)
                End If
                vR(i, 1) = Trim(s)
            Next i
            .Range("r1").Resize(n) = vR
        End With
    Next Ws
End Sub

替换文本来自两个不同列的数据

3 个答案: