Столкнулся со следующей задачей. Необходимо автозаполнить все значения в диапазоне т.е. не одно значение в списке растянуть до конца, а несколько кт. будут встречаться.
Если делать через подобный код, то на весь диапазон автозаполняется только первое значение [vba]
Код
Sub SmartFillDown()
Dim rng As Range, n As Long Set rng = ActiveCell.Offset(0, -1).CurrentRegion
If rng.Cells.Count > 1 Then n = rng.Cells(1).Row + rng.Rows.Count - ActiveCell.Row ActiveCell.AutoFill Destination:=ActiveCell.Resize(n, 1), Type:=xlFillValues End If
End Sub
[/vba]
Подскажите, как можно решить [moder]Используйте для кода кнопку #. Fx - это для формул.[/moder]
Доброго дня
Столкнулся со следующей задачей. Необходимо автозаполнить все значения в диапазоне т.е. не одно значение в списке растянуть до конца, а несколько кт. будут встречаться.
Если делать через подобный код, то на весь диапазон автозаполняется только первое значение [vba]
Код
Sub SmartFillDown()
Dim rng As Range, n As Long Set rng = ActiveCell.Offset(0, -1).CurrentRegion
If rng.Cells.Count > 1 Then n = rng.Cells(1).Row + rng.Rows.Count - ActiveCell.Row ActiveCell.AutoFill Destination:=ActiveCell.Resize(n, 1), Type:=xlFillValues End If
End Sub
[/vba]
Подскажите, как можно решить [moder]Используйте для кода кнопку #. Fx - это для формул.[/moder]alunet
Сообщение отредактировал alunet - Вторник, 07.02.2017, 20:45
ну вот маленький макросик( ущербный, т.к. только учусь) столбец D должен быть ,как у вас в примере , заполнен.макрос будет работать до последней заполненной ячейки столбца D [vba]
Код
Sub tutu() Dim tu& tu = Cells(Rows.Count, 4).End(xlUp).Row For i = 3 To tu If Cells(i, 3) = "" Then Cells(i, 6) = Cells(i - 1, 6) Else Cells(i, 6) = Cells(i, 3) End If Next i
End Sub
[/vba]
ну вот маленький макросик( ущербный, т.к. только учусь) столбец D должен быть ,как у вас в примере , заполнен.макрос будет работать до последней заполненной ячейки столбца D [vba]
Код
Sub tutu() Dim tu& tu = Cells(Rows.Count, 4).End(xlUp).Row For i = 3 To tu If Cells(i, 3) = "" Then Cells(i, 6) = Cells(i - 1, 6) Else Cells(i, 6) = Cells(i, 3) End If Next i
Sub Zapolnenye_Null() Application.ScreenUpdating = 0 cal_ = Application.Calculation Application.Calculation = xlCalculationManual On Error GoTo A n = Selection.Address If Range(n).Cells.Count - 1 Then Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" Range(n) = Range(n).Value End If A: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
[/vba]
У меня такой в Персонале лежит [vba]
Код
Sub Zapolnenye_Null() Application.ScreenUpdating = 0 cal_ = Application.Calculation Application.Calculation = xlCalculationManual On Error GoTo A n = Selection.Address If Range(n).Cells.Count - 1 Then Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" Range(n) = Range(n).Value End If A: Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub