Здравствуйте! Подскажите, как с помощью VBA реализовать следующую задачу - пользователь вводит в ячейку А1 произвольное число, которое при нажатии на кнопку должно вырезаться и вставляться в ячейку С1. При повторном действии со стороны пользователя (числа, вводимые в A1 могут быть любыми) аналогично должны заполняться ячейки С2, С3, ..., Сn.
Здравствуйте! Подскажите, как с помощью VBA реализовать следующую задачу - пользователь вводит в ячейку А1 произвольное число, которое при нажатии на кнопку должно вырезаться и вставляться в ячейку С1. При повторном действии со стороны пользователя (числа, вводимые в A1 могут быть любыми) аналогично должны заполняться ячейки С2, С3, ..., Сn.Aleksanqr
Sub ttt() Dim r_& r_ = Cells(Rows.Count, 3).End(xlUp).Row If Cells(1, 1) <> "" And Cells(1, 3) = "" Then Cells(1, 1).Copy Range("C" & r_).PasteSpecial Paste:=xlPasteValues Cells(1, 1).ClearContents Else Cells(1, 1).Copy Range("C" & r_ + 1).PasteSpecial Paste:=xlPasteValues Cells(1, 1).ClearContents End If End Sub
[/vba] как то так
И вам не хворать. [vba]
Код
Sub ttt() Dim r_& r_ = Cells(Rows.Count, 3).End(xlUp).Row If Cells(1, 1) <> "" And Cells(1, 3) = "" Then Cells(1, 1).Copy Range("C" & r_).PasteSpecial Paste:=xlPasteValues Cells(1, 1).ClearContents Else Cells(1, 1).Copy Range("C" & r_ + 1).PasteSpecial Paste:=xlPasteValues Cells(1, 1).ClearContents End If End Sub
может, лучше сразу переносить? Как только введете число в А1, так и переносится автоматом Тогда в модуль листа (правой мышой на ярлык листа - Исходый текст) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d_ As Range Set d_ = Intersect(Target, Range("A1")) If Not d_ Is Nothing Then If Not IsNumeric(d_) Then Exit Sub If d_ = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") Application.EnableEvents = 0 d_.Cut Cells(r_, 3) Application.EnableEvents = 1 Cells(1).Select End If End Sub
[/vba]
А с кнопочкой так можно [vba]
Код
Sub ttt() Dim d_ As Range Set d_ = Range("A1") If Not IsNumeric(d_) Then Exit Sub If d_ = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") d_.Cut Cells(r_, 3) Cells(1).Select End Sub
[/vba]
может, лучше сразу переносить? Как только введете число в А1, так и переносится автоматом Тогда в модуль листа (правой мышой на ярлык листа - Исходый текст) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d_ As Range Set d_ = Intersect(Target, Range("A1")) If Not d_ Is Nothing Then If Not IsNumeric(d_) Then Exit Sub If d_ = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") Application.EnableEvents = 0 d_.Cut Cells(r_, 3) Application.EnableEvents = 1 Cells(1).Select End If End Sub
[/vba]
А с кнопочкой так можно [vba]
Код
Sub ttt() Dim d_ As Range Set d_ = Range("A1") If Not IsNumeric(d_) Then Exit Sub If d_ = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") d_.Cut Cells(r_, 3) Cells(1).Select End Sub
_Boroda_, подскажи, пожалуйста, еще вот в чем. Моя задача претерпела небольшие изменения, а конкретно - по нажатию на твою кнопку данные должны вырезаться не только из А1, но и из B1 и вставляться в С1 и D1, соответственно. Причем, в B1 помимо цифр могут быть и буквы.
По аналогии я изменил твой код на следующий (заранее извиняюсь за возможную ересь, т. к. далек от VBA):
[vba]
Код
Sub ttt() Dim d_, f_ As Range Set d_ = Range("A1") Set f_ = Range("B1") If Not IsNumeric(d_) Then Exit Sub If d_ = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") d_.Cut Cells(r_, 3) f_.Cut Cells(r_, 4) Cells(1).Select End Sub
[/vba]
Дополнение, которое я внес в код, вроде бы, позволяет решить поставленную задачу. Вопрос в том - корректно ли внесены эти изменения, все ли верно с точки зрения читабельности и оптимальности написанного?
_Boroda_, подскажи, пожалуйста, еще вот в чем. Моя задача претерпела небольшие изменения, а конкретно - по нажатию на твою кнопку данные должны вырезаться не только из А1, но и из B1 и вставляться в С1 и D1, соответственно. Причем, в B1 помимо цифр могут быть и буквы.
По аналогии я изменил твой код на следующий (заранее извиняюсь за возможную ересь, т. к. далек от VBA):
[vba]
Код
Sub ttt() Dim d_, f_ As Range Set d_ = Range("A1") Set f_ = Range("B1") If Not IsNumeric(d_) Then Exit Sub If d_ = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") d_.Cut Cells(r_, 3) f_.Cut Cells(r_, 4) Cells(1).Select End Sub
[/vba]
Дополнение, которое я внес в код, вроде бы, позволяет решить поставленную задачу. Вопрос в том - корректно ли внесены эти изменения, все ли верно с точки зрения читабельности и оптимальности написанного?Aleksanqr
Sub ttt() Dim d_ As Range Set d_ = Range("A1:B1") If Not IsNumeric(d_(1)) Then Exit Sub If d_(1) = "" Or d_(2) = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") d_.Cut Cells(r_, 3) Range("A1").Select End Sub
[/vba] По поводу варно-неверно 1. Ячейки для вырезки и вставки рядом, поэтому лучше взять их сразу обе в одну переменную 2. Вот это [vba]
Код
Dim d_, f_ As Range
[/vba] объявит переменную f_ как Range, а переменную d_ как Variant. Нужно писать [vba]
Код
Dim d_ As Range, f_ As Range
[/vba] 3. Проверку не непустоту В1 нужно делать? Если нет, то в моем макросе кусок [vba]
Код
Or d_(2) = ""
[/vba] убейте
Такой вариант [vba]
Код
Sub ttt() Dim d_ As Range Set d_ = Range("A1:B1") If Not IsNumeric(d_(1)) Then Exit Sub If d_(1) = "" Or d_(2) = "" Then Exit Sub r_ = Cells(Rows.Count, 3).End(3).Row r_ = r_ + 1 + (Cells(r_, 3) = "") d_.Cut Cells(r_, 3) Range("A1").Select End Sub
[/vba] По поводу варно-неверно 1. Ячейки для вырезки и вставки рядом, поэтому лучше взять их сразу обе в одну переменную 2. Вот это [vba]
Код
Dim d_, f_ As Range
[/vba] объявит переменную f_ как Range, а переменную d_ как Variant. Нужно писать [vba]
Код
Dim d_ As Range, f_ As Range
[/vba] 3. Проверку не непустоту В1 нужно делать? Если нет, то в моем макросе кусок [vba]