Перенести (скопировать) значения столбца B соблюдая строчность, в нужную ячейку диапозона C:J

@artofnewman · Регистрация: 22.07.2018

Здравствуйте!!!
Помогите плиз!
Перенести (скопировать) значения столбца B соблюдая строку, в нужную ячейку диапазон C:J

@pashulka · 27.01.2019, 15:45

Visual Basic

Private Sub Test()
    Dim c As Range
    For Each c In Range("A4", Cells(Rows.Count, "A").End(xlUp))
        Cells(c.Row, Rows(2).Find(c, , xlValues, xlWhole).Column) = c(1, 2)
    Next
End Sub

Если же существует вероятность отсутствия значений столбца A во второй строке, то :

Visual Basic

Private Sub Test2()
    Dim c1 As Range, c2 As Range
    For Each c1 In Range("A4", Cells(Rows.Count, "A").End(xlUp))
        Set c2 = Rows(2).Find(c1, , xlValues, xlWhole)
        If Not c2 Is Nothing Then
           Cells(c1.Row, c2.Column) = c1(1, 2)
        Else
           c1.Interior.Color = vbRed
        End If
    Next
End Sub

@artofnewman · 27.01.2019, 15:55 **[ТС]**

Вы гений!!!!!!!!!
Спасибо!!!!
Спасли от мук вечных!!!!!

@Казанский · 27.01.2019, 16:03

artofnewman,

Visual Basic

Sub Ar()
  With Range("C4:J17")
    .Formula = "=IF(AND($A4=C$2,$B4<>""""),$B4,"""")"
    .Value = .Value
  End With
End Sub

@artofnewman · 27.01.2019, 16:08 **[ТС]**

Вы гений!!!!!!!!!
Спасибо!!!!
Спасли от мук вечных!!!!!

Добавлено через 1 минуту
Спасибо!!! Всем !!!!!
Благодарен!!!!!!!!!!!!!
Пусть удача будет с вами всегда!

@artofnewman 1 / 1 / 0 Регистрация: 22.07.2018 Сообщений: 80
	27.01.2019, 15:55 [ТС]	3
	Вы гений!!!!!!!!! Спасибо!!!! Спасли от мук вечных!!!!! 0

@artofnewman 1 / 1 / 0 Регистрация: 22.07.2018 Сообщений: 80
	27.01.2019, 16:08 [ТС]	5
	Вы гений!!!!!!!!! Спасибо!!!! Спасли от мук вечных!!!!! Добавлено через 1 минуту Спасибо!!! Всем !!!!! Благодарен!!!!!!!!!!!!! Пусть удача будет с вами всегда! 0

Опции темы