Здравствуйте! Пытаюсь сделать макрос, который будет собирать нужные мне данные с листа "Расчет" и копировать их в нужные ячейки на листе "Результат". Количество строк, которые выделены желтым, будет всегда разное. Значения из зеленых строк нужно вставлять на лист "Результат". Количество образцов тоже будет разным.
Как я пытаюсь сделать это сейчас: нашел макрос, который ищет строку по названию и выдает ее номер:
Код
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. Минус в том, что:
- этот макрос копирует значения только в пределах одного листа, а мне нужно на лист "Результат"
- макрос находит только первое совпадение словосочетания "Нормативное значение", а мне нужно, чтобы он сделал это для всех образцов, чтобы получить номера этих строк
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 показывает адреса строк, где найдено "Нормативное значение"
как теперь это сделать, когда номеров строк несколько?
При активном листе Расчет запустить макрос, для двух столбцов
Код
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