Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос для вырезки/вставки числа из одной ячейки в другую. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для вырезки/вставки числа из одной ячейки в другую. (Макросы/Sub)
Макрос для вырезки/вставки числа из одной ячейки в другую.
Aleksanqr Дата: Среда, 06.06.2018, 03:32 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте! Подскажите, как с помощью VBA реализовать следующую задачу - пользователь вводит в ячейку А1 произвольное число, которое при нажатии на кнопку должно вырезаться и вставляться в ячейку С1. При повторном действии со стороны пользователя (числа, вводимые в A1 могут быть любыми) аналогично должны заполняться ячейки С2, С3, ..., Сn.
 
Ответить
СообщениеЗдравствуйте! Подскажите, как с помощью VBA реализовать следующую задачу - пользователь вводит в ячейку А1 произвольное число, которое при нажатии на кнопку должно вырезаться и вставляться в ячейку С1. При повторном действии со стороны пользователя (числа, вводимые в A1 могут быть любыми) аналогично должны заполняться ячейки С2, С3, ..., Сn.

Автор - Aleksanqr
Дата добавления - 06.06.2018 в 03:32
китин Дата: Среда, 06.06.2018, 07:30 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 7013
Репутация: 1073 ±
Замечаний: 0% ±

Excel 2007;2010;2016
И вам не хворать. :D
[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
[/vba]
как то так
К сообщению приложен файл: Aleksanqr.xlsm (15.6 Kb)


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852


Сообщение отредактировал китин - Среда, 06.06.2018, 10:06
 
Ответить
СообщениеИ вам не хворать. :D
[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
[/vba]
как то так

Автор - китин
Дата добавления - 06.06.2018 в 07:30
_Boroda_ Дата: Среда, 06.06.2018, 09:28 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
может, лучше сразу переносить? Как только введете число в А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]
К сообщению приложен файл: 71989.xlsm (14.1 Kb) · 816758.xlsm (14.1 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщениеможет, лучше сразу переносить? Как только введете число в А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]

Автор - _Boroda_
Дата добавления - 06.06.2018 в 09:28
Aleksanqr Дата: Среда, 06.06.2018, 11:54 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Ребят, благодарю вас за помощь! Воспользуюсь вариантами _Boroda_ - это именно то, что нужно!


Сообщение отредактировал Aleksanqr - Четверг, 07.06.2018, 06:49
 
Ответить
СообщениеРебят, благодарю вас за помощь! Воспользуюсь вариантами _Boroda_ - это именно то, что нужно!

Автор - Aleksanqr
Дата добавления - 06.06.2018 в 11:54
Aleksanqr Дата: Четверг, 07.06.2018, 06:49 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
_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
Дата добавления - 07.06.2018 в 06:49
_Boroda_ Дата: Четверг, 07.06.2018, 10:51 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Такой вариант
[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]
Код
Or d_(2) = ""
[/vba] убейте
К сообщению приложен файл: 816758_1.xlsm (15.4 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТакой вариант
[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]
Код
Or d_(2) = ""
[/vba] убейте

Автор - _Boroda_
Дата добавления - 07.06.2018 в 10:51
Aleksanqr Дата: Четверг, 07.06.2018, 13:54 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
_Boroda_, спасибо за поправки и объяснения!
 
Ответить
Сообщение_Boroda_, спасибо за поправки и объяснения!

Автор - Aleksanqr
Дата добавления - 07.06.2018 в 13:54
Aleksanqr Дата: Четверг, 07.06.2018, 20:30 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
_Boroda_, объясни, пожалуйста, строку:
[vba]
Код

r_ = Cells(Rows.Count, 3).End(3).Row
[/vba]

Не могу до конца понять суть End(3).
 
Ответить
Сообщение_Boroda_, объясни, пожалуйста, строку:
[vba]
Код

r_ = Cells(Rows.Count, 3).End(3).Row
[/vba]

Не могу до конца понять суть End(3).

Автор - Aleksanqr
Дата добавления - 07.06.2018 в 20:30
_Boroda_ Дата: Четверг, 07.06.2018, 20:39 | Сообщение № 9
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Это мы как бы встаем в последнюю ячейку столбца 3 и жмем Контрл СтрелкаВверх
Почему 3 в Еnd(3)? http://www.excelworld.ru/forum/10-34334-224656-16-1499155316


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭто мы как бы встаем в последнюю ячейку столбца 3 и жмем Контрл СтрелкаВверх
Почему 3 в Еnd(3)? http://www.excelworld.ru/forum/10-34334-224656-16-1499155316

Автор - _Boroda_
Дата добавления - 07.06.2018 в 20:39
Aleksanqr Дата: Пятница, 08.06.2018, 08:55 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
_Boroda_, еще раз благодарю за помощь!
 
Ответить
Сообщение_Boroda_, еще раз благодарю за помощь!

Автор - Aleksanqr
Дата добавления - 08.06.2018 в 08:55
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для вырезки/вставки числа из одной ячейки в другую. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!