VBA, найти и скопировать

Question

Необходима из столбца (например B) найти все ячейки с определенным текстом (например <name> или <desc>) и скопировать их в другой столбец (например С) в том же ряду.

Answer 1

Dim sheetName, myString As String
Dim x As Integer

sheetName =    'сюда присвоите название листа (в двойных кавычках например "Лист1") вашей книги, где требуется выполнить макрос.
х =            ' здесь, присвоите порядковый номер столбца от 0 до N слева направо, где нулевой столбец - это столбец А, 1-й - столбец B и так далее.
myString =     'здесь присвоите часть значения, которое нужно найти в ячейках (в двойных кавычках разумеется!!!

With Sheets(sheetName).Range("A1")
  Do While .Offset(i,x) <> ""     
    If InStr(1, .Offset(i,x), myString) > 0 Then
       .Offset(i,x+1).Value = .Offset(i,x).Value
    End If

   i=i+1   ' не забудьте эту строку с инкрементом!!! Иначе всё зависнет!
  Loop
End With

По итогу выполнения кода, вы получите таблицу, в которой из всех ячеек столбца номер "X" будут копированы значения ячеек в соседний (справа) столбец, если они будут содержать в своём значении строку "myString" ВНИМАНИЕ! Код обработает столбец с номером указанным в X до первой пустой ячейки в этом столбце. То есть, он для неразрывного диапазона любого размера подходит, т.к конец диапазона определяется первой встреченной пустой ячейкой в столбце. Если вам нужно перебрать известный диапазон (по размеру, например 1000 строк в столбце), независимо от того будут ли встреченные пустые ячейки, то замените строку:

Do While .Offset(i,x) <> ""
' на строку:
Do While i <> 1000   'вместо 1000 количество строк которые нужно обработать в таблице

БЛОГ НА HUSL

VBA, найти и скопировать

Ответы (1 шт):