Страницы: 1
RSS
Поиск нескольких совпадений и вставка значений на другой лист
 
Здравствуйте! Пытаюсь сделать макрос, который будет собирать нужные мне данные с листа "Расчет" и копировать их в нужные ячейки на листе "Результат". Количество строк, которые выделены желтым, будет всегда разное. Значения из зеленых строк нужно вставлять на лист "Результат". Количество образцов тоже будет разным.

Как я пытаюсь сделать это сейчас: нашел макрос, который ищет строку по названию и выдает ее номер:
Код
Sub primer1()
Dim myPhrase As Variant, myCell As Range
myPhrase = "Нормативное значение"
Set myCell = Range("A2:AC52").Find(myPhrase)
Range("AE15") = "=K" & myCell.Row
Range("AF15") = "=N" & myCell.Row
Range("AG15") = "=R" & myCell.Row
End Sub

Беру этот номер и подставляю его к ячейке, которую хочу скопировать, а затем, вставляю все это в другую ячейку, с помощью Range. Возможно, это совсем неправильный подход, но я плохо разбираюсь в VBA. Минус в том, что:

- этот макрос копирует значения только в пределах одного листа, а мне нужно на лист "Результат"

- макрос находит только первое совпадение словосочетания "Нормативное значение", а мне нужно, чтобы он сделал это для всех образцов, чтобы получить номера этих строк

Подскажите, как это реализовать?

Изменено: antisept - 05.06.2021 15:32:35
 
antisept,
Цитата
а мне нужно на лист "Результат"
Почему на листе Результат для Образец №3 три значения берутся из листа Расчет строка 26, а два значения из строки 21 ?
Изменено: Kuzmich - 05.06.2021 15:29:33
 
Ошибся. Перезалил пример
Изменено: vikttur - 05.06.2021 23:04:31
 
Цитата
а мне нужно, чтобы он сделал это для всех образцов
И для каждого образца данные берутся из разных столбцов листа Расчет?
Зачем нужно объединение ячеек на листе Результат?
 
Цитата
Kuzmich написал:
И для каждого образца данные берутся из разных столбцов листа Расчет?
Могут быть из разных, могут из одинаковых. В зависимости от самих образцов. Меня устроит даже вариант с одинаковыми столбцами
Цитата
Kuzmich написал:
Зачем нужно объединение ячеек на листе Результат?

Это для того, чтобы таблицу потом в word перенести и выровнять значения в ячейках по центру. На листе "Результат" таблица не полная. Она еще будет продолжаться вправо и в тех ячейках, будут записываться значения в виде дробей: одно вверху, другое внизу, вот так:
 
Цитата
макрос находит только первое совпадение словосочетания "Нормативное значение", а мне нужно, чтобы он сделал это для всех образцов, чтобы получить номера этих строк
Код
Sub primer1()
Dim myPhrase As String, myCell As Range
Dim FAdr As String
Dim Result As Worksheet
  Set Result = ThisWorkbook.Worksheets("Результат")
  With Result
    myPhrase = "Нормативное значение"
    Set myCell = Range("A2:AC52").Find(myPhrase)
     If Not myCell Is Nothing Then
       FAdr = myCell.Address
       Do
         'в зависимости от Образца переносим данные на лист Результат
       
         Set myCell = Range("A2:AC52").FindNext(myCell)
       Loop While myCell.Address <> FAdr
     End If
  End With
End Sub

myCell.Address показывает адреса строк, где найдено  "Нормативное значение"
 
Не совсем понятно, как теперь вывести нужные ячейки. До этого, я просто делал так:
Код
Range("AE15") = "=K" & myCell.Row
Range("AF15") = "=N" & myCell.Row
Range("AG15") = "=R" & myCell.Row

А как теперь это сделать, когда номеров строк несколько?
Изменено: vikttur - 05.06.2021 23:04:54
 
Цитата
как теперь вывести нужные ячейки
Для этого на листе Результат надо найти последнюю ячейку и в нее перенести данные по соответствующему образцу
 
Цитата
как теперь это сделать, когда номеров строк несколько?
При активном листе Расчет запустить макрос, для двух столбцов
Код
Sub primer1()
Dim myPhrase As String, myCell As Range
Dim cell_row As Long
Dim iLR As Long
Dim Obraz As Range
Dim FAdr As String
Dim Result As Worksheet
  Set Result = ThisWorkbook.Worksheets("Результат")
  With Result
    .Cells.Clear
    myPhrase = "Нормативное значение"
  Set Obraz = Columns("F:G").Find("Образец №", , xlValues, xlPart)
    Set myCell = Columns("B:E").Find(myPhrase, Obraz.Offset(, -4), xlValues, xlWhole)
    Set myCell = Obraz.Offset(1, -4)
     If Not myCell Is Nothing Then
       FAdr = Obraz.Address
       Do
         cell_row = myCell.Row
         'в зависимости от Образца переносим данные на лист Результат
         iLR = .Cells(.Rows.Count, "D").End(xlUp).Row + 2
         .Cells(iLR, "D") = Obraz                   'Образец №
         .Range(.Cells(iLR, "D"), .Cells(iLR + 1, "D")).Merge
         .Cells(iLR, "D").HorizontalAlignment = xlCenter
         .Cells(iLR, "D").VerticalAlignment = xlCenter
         .Range(.Cells(iLR, "D"), .Cells(iLR + 1, "D")).Borders.Weight = xlThin

         .Cells(iLR, "E") = Cells(cell_row, "F")    'из столбца F листа Расчет в столбец Е Результата
         .Range(.Cells(iLR, "E"), .Cells(iLR + 1, "E")).Merge
         .Cells(iLR, "E").VerticalAlignment = xlCenter
         .Range(.Cells(iLR, "E"), .Cells(iLR + 1, "E")).Borders.Weight = xlThin
         .Cells(iLR, "E").NumberFormat = "0.000"
         
         .Cells(iLR, "F") = Cells(cell_row, "G")    'из столбца G листа Расчет в столбец F Результата
         .Range(.Cells(iLR, "F"), .Cells(iLR + 1, "F")).Merge
         .Cells(iLR, "F").VerticalAlignment = xlCenter
         .Range(.Cells(iLR, "F"), .Cells(iLR + 1, "F")).Borders.Weight = xlThin
         .Cells(iLR, "F").NumberFormat = "0.000"
         
         Set Obraz = Columns("F:G").Find("Образец №", Obraz, xlValues, xlPart)
         Set myCell = Columns("B:E").Find(myPhrase, Obraz.Offset(, -3), xlValues, xlWhole)
       Loop While Obraz.Address <> FAdr
     End If
  End With
End Sub
 
Добрый день. Подскажите пожалуйста как для myphrase задать переменную. Тоесть на листе 2 есть список искомых слов (А2:А15) которые надо найти ?  
Страницы: 1
Наверх