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

Если в столбце E  встречается "Иванов, Сидоров, Петров", тогда скопировать их, и их соседнюю ячейку, а потом вставить в самую последнюю нижнюю строку (количество строк всегда меняется). В файле я выделил чтобы из зеленой зоны они перешли в оранжевую.

Что я пытался сделать:
Код
Sub Source()
Dim LastRow As Long, iCell As Range

lLastRow = Sheets("1").Cells(Sheets("1").Rows.Count,1).End(xlUp).Row + 1

        For Each iCell In Worksheets("1").Range("E2:E"& LastRow)
            If iCell = "Иванов" Or iCell = "Сидоров" Or iCell = "Петров" Then
                       iCell.Copy Sheets("1").Range("C" & lLastRow).Paste
                       iCell.Offset(0, -1)Copy Sheets("1").Range("B" & lLastRow).Paste
                       iCell.Offset(0, -4) Sheets("1").Range("A" & lLastRow) = "1"
            Else

            End If
        Next iCell
End Sub
 
Только поправил макрос
Код
Sub Source()

    Dim LastRow As Long, iCell As Range
With Sheets("Sheet1")
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    For Each iCell In .Range("e2:e" & LastRow)
        If iCell = "Иванов" Or iCell = "Сидоров" Or iCell = "Петров" Then
            iCell.Offset(0, -1).Resize(1, 2).Copy .Range("b" & LastRow)
            LastRow = LastRow + 1
        End If
    Next iCell
End With
End Sub
 
Спасибо, а если эти столбцы не рядом с друг другом, файл для примера прикрепляю. Resize я так понимаю уже не сработает?
 
Код
Sub Source()
    Dim LastRow As Long, iCell As Range
    With Sheets("Sheet1")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        For Each iCell In .Range("G2:G" & LastRow)
            Select Case iCell
            Case "Иванов", "Сидоров", "Петров"
                iCell.Offset(0, -1).Resize(1, 2).Copy .Range("b" & LastRow)
                .Range("b" & LastRow).Resize(1, 2) = Array(.Cells(iCell.Row, "D"), iCell)
                LastRow = LastRow + 1
            End Select
        Next iCell
    End With
End Sub
 
Спасибо.

Я наверное уже немного наглею, но как-то можно в соседнюю ячейку (в колонке А), слева сразу прописать конкретную цифру "1", для тех записей которые уходят вниз (оранжевый цвет) ?)) Этот код потом мне нужен будет.

И ещё один вопрос не по теме. Подскажите какой-то сайт с простым и очень подробным синтаксисом по VBA, где бы можно было бы черпать информацию по коду?  
 
Код
Sub Source()
    Dim LastRow As Long, iCell As Range
    With Sheets("Sheet1")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        For Each iCell In .Range("G2:G" & LastRow)
            Select Case iCell
            Case "Иванов", "Сидоров", "Петров"
                iCell.Offset(0, -1).Resize(1, 2).Copy .Range("b" & LastRow)
                .Range("A" & LastRow).Resize(1, 2) = Array(1, .Cells(iCell.Row, "D"), iCell)
                LastRow = LastRow + 1
            End Select
        Next iCell
    End With
End Sub
 
Цитата
yarlo написал: какой-то сайт с простым и очень подробным синтаксисом по VBA
Поиск. Выбирайте что Вам по-душе.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Всем спасибо
Страницы: 1
Наверх