Добрый день уважаемые форумчане. В очередной раз прошу помощи. Есть прайс лист, где название категории указано над всей категорией, для сортировки очень неудобно. Использую для сортировки, я столбец под номером 10 Следовательно мне нужно чтобы в него скопировалось, название раздела с поля над ним. И так для всех позиций в прайсе. Из примера будет понятно, что именно неудобно.
Добрый день уважаемые форумчане. В очередной раз прошу помощи. Есть прайс лист, где название категории указано над всей категорией, для сортировки очень неудобно. Использую для сортировки, я столбец под номером 10 Следовательно мне нужно чтобы в него скопировалось, название раздела с поля над ним. И так для всех позиций в прайсе. Из примера будет понятно, что именно неудобно.wwizard
Еще 3 варианта макроса. на 500000 последний самый быстрый [vba]
Код
Sub tt() Application.ScreenUpdating = 0 r1_ = Range("A" & Rows.Count).End(xlUp).Row For i = 2 To r1_ If Range("B" & i) = "" Then n_ = Range("A" & i) Else Range("G" & i) = n_ End If Next i End Sub
Sub ttt() Application.ScreenUpdating = 0 r1_ = Range("A" & Rows.Count).End(xlUp).Row Range("G3:G" & r1_).FormulaR1C1 = _ "=IF(RC[-5]="""","""",IF(R[-1]C[-5]="""",R[-1]C[-6],R[-1]C))" Range("G3:G" & r1_).Copy Range("G3:G" & r1_).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
Sub tttt() Dim ar1, ar0 Application.ScreenUpdating = 0 r1_ = Range("A" & Rows.Count).End(xlUp).Row - 1 ar0 = Range("A2:B" & r1_ + 1) ReDim ar1(1 To r1_, 0 To 0) For i = 1 To r1_ ' Debug.Print i If ar0(i, 2) = "" Then ar1(i, 0) = "" n_ = ar0(i, 1) Else ar1(i, 0) = n_ End If Next i Range("G2:G" & r1_ + 1) = ar1 End Sub
[/vba]
Еще 3 варианта макроса. на 500000 последний самый быстрый [vba]
Код
Sub tt() Application.ScreenUpdating = 0 r1_ = Range("A" & Rows.Count).End(xlUp).Row For i = 2 To r1_ If Range("B" & i) = "" Then n_ = Range("A" & i) Else Range("G" & i) = n_ End If Next i End Sub
Sub ttt() Application.ScreenUpdating = 0 r1_ = Range("A" & Rows.Count).End(xlUp).Row Range("G3:G" & r1_).FormulaR1C1 = _ "=IF(RC[-5]="""","""",IF(R[-1]C[-5]="""",R[-1]C[-6],R[-1]C))" Range("G3:G" & r1_).Copy Range("G3:G" & r1_).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
Sub tttt() Dim ar1, ar0 Application.ScreenUpdating = 0 r1_ = Range("A" & Rows.Count).End(xlUp).Row - 1 ar0 = Range("A2:B" & r1_ + 1) ReDim ar1(1 To r1_, 0 To 0) For i = 1 To r1_ ' Debug.Print i If ar0(i, 2) = "" Then ar1(i, 0) = "" n_ = ar0(i, 1) Else ar1(i, 0) = n_ End If Next i Range("G2:G" & r1_ + 1) = ar1 End Sub