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

Вход

Регистрация

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

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос значений по дабл клику из одной ячейки в другую (Макросы/Sub)
Перенос значений по дабл клику из одной ячейки в другую
wxqzwxqz Дата: Четверг, 04.02.2016, 09:47 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день.
Прошу помочь сделать макрос, т.к. сам не силен в этом.
Опишу суть. Сделал таблицу, в которой собрал комплектующие и фирмы, которых они могут быть. В зависимости от тех задания нужно в сводную таблицу выбрать комплектующие определенных фирм и скалькулировать стоимость. Простое копирование ячеек не очень удобно, т.к. вариантов комплектаций много и таблицы довольно большие. Если можно, помогите сделать макрос, который при двойном нажатии на фирму- производителя будет подставлять ее название и цену изделия в сводную таблицу. Часть таблицы прилагаю. Красным выделил то, что нужно было добавить в сводную (при двойном нажатии на Е5 подставить ее значение в С29, а значение Е6 в D29). Можно на примере первых двух строк, остальные попробую сделать по аналогии. Заранее спасибо.
К сообщению приложен файл: 9588582.xlsx(12Kb)
 
Ответить
СообщениеДобрый день.
Прошу помочь сделать макрос, т.к. сам не силен в этом.
Опишу суть. Сделал таблицу, в которой собрал комплектующие и фирмы, которых они могут быть. В зависимости от тех задания нужно в сводную таблицу выбрать комплектующие определенных фирм и скалькулировать стоимость. Простое копирование ячеек не очень удобно, т.к. вариантов комплектаций много и таблицы довольно большие. Если можно, помогите сделать макрос, который при двойном нажатии на фирму- производителя будет подставлять ее название и цену изделия в сводную таблицу. Часть таблицы прилагаю. Красным выделил то, что нужно было добавить в сводную (при двойном нажатии на Е5 подставить ее значение в С29, а значение Е6 в D29). Можно на примере первых двух строк, остальные попробую сделать по аналогии. Заранее спасибо.

Автор - wxqzwxqz
Дата добавления - 04.02.2016 в 09:47
buchlotnik Дата: Четверг, 04.02.2016, 10:03 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3004
Репутация: 839 ±
Замечаний: 0% ±

2010, 2013, 2016 RUS / ENG
в лоб [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cells(29 + (Selection.Row - 5) / 3, 3) = Selection
    Cells(29 + (Selection.Row - 5) / 3, 4) = Selection.Offset(1, 0)
End Sub

[/vba]
К сообщению приложен файл: 9588582.xlsm(18Kb)


каждому For - Next!
платная помощь:
ЯД: 410012595572239
buchlotnik@mail.ru
 
Ответить
Сообщениев лоб [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cells(29 + (Selection.Row - 5) / 3, 3) = Selection
    Cells(29 + (Selection.Row - 5) / 3, 4) = Selection.Offset(1, 0)
End Sub

[/vba]

Автор - buchlotnik
Дата добавления - 04.02.2016 в 10:03
Wasilich Дата: Четверг, 04.02.2016, 10:30 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1195
Репутация: 316 ±
Замечаний: 0% ±

2003
На все
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   For i = 29 To 34
     If Trim(Cells(i, 3)) = Trim(Target) Then
        s = Target.Row + 1
        k = Target.Column
        Cells(i, 4) = Cells(s, k)
     End If
   Next
   Cancel = 1          ' что бы курсор не проваливался
End Sub
[/vba]
 
Ответить
СообщениеНа все
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   For i = 29 To 34
     If Trim(Cells(i, 3)) = Trim(Target) Then
        s = Target.Row + 1
        k = Target.Column
        Cells(i, 4) = Cells(s, k)
     End If
   Next
   Cancel = 1          ' что бы курсор не проваливался
End Sub
[/vba]

Автор - Wasilich
Дата добавления - 04.02.2016 в 10:30
wxqzwxqz Дата: Четверг, 04.02.2016, 10:44 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо огромное! Очень помогли.
Wasilic, вопрос к вам: написано "чтобы курсор не проваливался", но при двойном клике все-равно переходит в режим редактирования. Или это не про это?
 
Ответить
СообщениеСпасибо огромное! Очень помогли.
Wasilic, вопрос к вам: написано "чтобы курсор не проваливался", но при двойном клике все-равно переходит в режим редактирования. Или это не про это?

Автор - wxqzwxqz
Дата добавления - 04.02.2016 в 10:44
Wasilich Дата: Четверг, 04.02.2016, 10:51 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1195
Репутация: 316 ±
Замечаний: 0% ±

2003
%) У меня не проваливается! Попробуйте 1 заменить на True. Иначе не знаю.
И можно чуть сократить
[vba]
Код
If Trim(Cells(i, 3)) = Trim(Target) Then
        Cells(i, 4) = Target.Offset(1, 0)
     End If
[/vba]


Сообщение отредактировал Wasilic - Четверг, 04.02.2016, 10:59
 
Ответить
Сообщение%) У меня не проваливается! Попробуйте 1 заменить на True. Иначе не знаю.
И можно чуть сократить
[vba]
Код
If Trim(Cells(i, 3)) = Trim(Target) Then
        Cells(i, 4) = Target.Offset(1, 0)
     End If
[/vba]

Автор - Wasilich
Дата добавления - 04.02.2016 в 10:51
wxqzwxqz Дата: Четверг, 04.02.2016, 11:06 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Wasilic, Курсор проваливаться перестал, но почему-то при нажатии ячейки поменялись несколько раз, потом перестали
 
Ответить
СообщениеWasilic, Курсор проваливаться перестал, но почему-то при нажатии ячейки поменялись несколько раз, потом перестали

Автор - wxqzwxqz
Дата добавления - 04.02.2016 в 11:06
Wasilich Дата: Четверг, 04.02.2016, 11:10 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1195
Репутация: 316 ±
Замечаний: 0% ±

2003
но почему-то при нажатии ячейки поменялись несколько раз, потом перестали
Не понимаю, какие ячейки, где? Как поменялись? О чем речь?
 
Ответить
Сообщение
но почему-то при нажатии ячейки поменялись несколько раз, потом перестали
Не понимаю, какие ячейки, где? Как поменялись? О чем речь?

Автор - Wasilich
Дата добавления - 04.02.2016 в 11:10
wxqzwxqz Дата: Пятница, 05.02.2016, 08:15 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Щелкаю на название какой-либо фирмы - она подставляется в таблицу вместе с ценой, щелкаю на другие - ничего не происходит
 
Ответить
СообщениеЩелкаю на название какой-либо фирмы - она подставляется в таблицу вместе с ценой, щелкаю на другие - ничего не происходит

Автор - wxqzwxqz
Дата добавления - 05.02.2016 в 08:15
Wasilich Дата: Пятница, 05.02.2016, 09:38 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1195
Репутация: 316 ±
Замечаний: 0% ±

2003
Видимо не понял задачу. Так что ли?
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Range("C5:G21"), Target) Is Nothing Then
    S = Range("B" & Rows.Count).End(xlUp).Row + 1
    Cells(S, 2) = Cells(Target.Row, 2)
    Cells(S, 3) = Target
    Cells(S, 4) = Target.Offset(1, 0)
End If
Cancel = 1          ' что бы курсор не проваливался
End Sub
[/vba]
К сообщению приложен файл: wxqzwxqz.xls(41Kb)


Сообщение отредактировал Wasilic - Пятница, 05.02.2016, 09:41
 
Ответить
СообщениеВидимо не понял задачу. Так что ли?
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Range("C5:G21"), Target) Is Nothing Then
    S = Range("B" & Rows.Count).End(xlUp).Row + 1
    Cells(S, 2) = Cells(Target.Row, 2)
    Cells(S, 3) = Target
    Cells(S, 4) = Target.Offset(1, 0)
End If
Cancel = 1          ' что бы курсор не проваливался
End Sub
[/vba]

Автор - Wasilich
Дата добавления - 05.02.2016 в 09:38
wxqzwxqz Дата: Пятница, 05.02.2016, 10:11 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Wasilic, таблица огонь получилась! Если не трудно, объясните, пожалуйста, что надо изменить, чтобы опустить кнопку и сводную таблицу вниз и сохранить ее работоспособность, т.к. основная таблица будет расширяться (как ее расширять я понял).
 
Ответить
СообщениеWasilic, таблица огонь получилась! Если не трудно, объясните, пожалуйста, что надо изменить, чтобы опустить кнопку и сводную таблицу вниз и сохранить ее работоспособность, т.к. основная таблица будет расширяться (как ее расширять я понял).

Автор - wxqzwxqz
Дата добавления - 05.02.2016 в 10:11
Wasilich Дата: Пятница, 05.02.2016, 10:38 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 1195
Репутация: 316 ±
Замечаний: 0% ±

2003
что надо изменить, чтобы опустить кнопку и сводную таблицу вниз
Тяжелый случай!
На номере 22 нумерации строк, нажимаете Левую Кнопку Мышки, удерживая протягиваете вниз помечая столько строк, сколько надо вставить. Отпустив левую кнопку мышки, находясь на нумераторе выделенных строк, нажмите правую кнопку мыши. В открывшемся окошке выберите - "Добавить ячейки".
Вообще то, была надежда что,
на примере первых двух строк, остальные попробую сделать по аналогии.

ЗЫ В связи с удлинением таблицы, в строке макроса
[vba]
Код
If Not Application.Intersect(Range("C5:G21"), Target) Is Nothing Then
[/vba]укажите новые её координаты.


Сообщение отредактировал Wasilic - Пятница, 05.02.2016, 11:00
 
Ответить
Сообщение
что надо изменить, чтобы опустить кнопку и сводную таблицу вниз
Тяжелый случай!
На номере 22 нумерации строк, нажимаете Левую Кнопку Мышки, удерживая протягиваете вниз помечая столько строк, сколько надо вставить. Отпустив левую кнопку мышки, находясь на нумераторе выделенных строк, нажмите правую кнопку мыши. В открывшемся окошке выберите - "Добавить ячейки".
Вообще то, была надежда что,
на примере первых двух строк, остальные попробую сделать по аналогии.

ЗЫ В связи с удлинением таблицы, в строке макроса
[vba]
Код
If Not Application.Intersect(Range("C5:G21"), Target) Is Nothing Then
[/vba]укажите новые её координаты.

Автор - Wasilich
Дата добавления - 05.02.2016 в 10:38
wxqzwxqz Дата: Пятница, 05.02.2016, 11:02 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Я пробовал ячейки выделять и за крестик перетаскивать - не работало. Спасибо, сделал как вы сказали - всё работает.
 
Ответить
СообщениеЯ пробовал ячейки выделять и за крестик перетаскивать - не работало. Спасибо, сделал как вы сказали - всё работает.

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

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