Заменить текст Данные из двух разных столбцов

Я хочу удалить одно слово из нескольких слов, разделенных запятой:

Я хочу макрос, который должен работать для всех листов в книге.

У меня есть следующие данные в столбце A в Sheet1, Sheet2, Sheet3. Число строк и данных различно для разных листов.

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 

Я хочу удалить слово в столбце A из столбца R.

Для этого мы можем использовать формулу в R1

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

Но он работает только для R1.

Я хочу макрос, который обеспечивает желаемый результат и должен работать для всех листов. Поскольку разные данные присутствуют в Sheet1, sheet2 … sheetn. Помоги мне.

Попробуй это

 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 

Напишите эту формулу в R1 и перетащите вниз

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

Я чувствую, что это определенно возможно с функциями excel, поскольку VB кажется излишним. Это помещает вашу большую строку в col Q в массив и удаляет все значения в столбце 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 
Давайте будем гением компьютера.