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

Вход

Регистрация

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

 

= Мир MS Excel/При клике по ячейке, скопировать её содержимое в другую - Мир MS Excel

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

Excel 2016
Подскажите пожалуйста. Есть таблица с набором цифр. Цифры необходимо выбирать в порядке возрастания от 1 до 25 на черном фоне. При нажати на цифру 1 она копируется в ячейку I1, при нажатии на 2 - I2 и т.д. Можно ли как то сделать, что бы если нажал 1,2,3,4, а 5 пропустил, то 6 и последующие цифры не копировались пока не будет нажата цифра 5
К сообщению приложен файл: 6848664.xlsm (20.1 Kb)
 
Ответить
СообщениеПодскажите пожалуйста. Есть таблица с набором цифр. Цифры необходимо выбирать в порядке возрастания от 1 до 25 на черном фоне. При нажати на цифру 1 она копируется в ячейку I1, при нажатии на 2 - I2 и т.д. Можно ли как то сделать, что бы если нажал 1,2,3,4, а 5 пропустил, то 6 и последующие цифры не копировались пока не будет нажата цифра 5
Автор - ivstepa
Дата добавления - 01.07.2020 в 09:29
Апострофф Дата: Среда, 01.07.2020, 12:08 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
ivstepa, Здравствуйте.
Для выполнения условия задачи я осмелился чуть сократить Ваш код:
модуль Лист1 теперь выглядит так -
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Interior.Color = 0 Then
  If Target = T + 1 Then
    Target.Copy Cells((T Mod 7) + 1, 9 + (T \ 7))
    T = T + 1
  End If
End If
End Sub
[/vba]
модуль Module1 так -
[vba]
Код
Global T&
Sub Очистить()
'
' Очистить Макрос
'

'
T = O
With Range("I1:L7")   '.Select
    With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With .Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    .ClearContents
End With
End Sub
[/vba]
 
Ответить
Сообщениеivstepa, Здравствуйте.
Для выполнения условия задачи я осмелился чуть сократить Ваш код:
модуль Лист1 теперь выглядит так -
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Interior.Color = 0 Then
  If Target = T + 1 Then
    Target.Copy Cells((T Mod 7) + 1, 9 + (T \ 7))
    T = T + 1
  End If
End If
End Sub
[/vba]
модуль Module1 так -
[vba]
Код
Global T&
Sub Очистить()
'
' Очистить Макрос
'

'
T = O
With Range("I1:L7")   '.Select
    With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With .Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    .ClearContents
End With
End Sub
[/vba]
Автор - Апострофф
Дата добавления - 01.07.2020 в 12:08
Апострофф Дата: Среда, 01.07.2020, 12:17 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
кстати, теперь вы можете менять положение черного и белого, а также расположение чисел. Лишь бы последовательность 1-25 в чёрном присутствовала.
Жёсткой привязки к адресам больше нет!


Сообщение отредактировал Апострофф - Среда, 01.07.2020, 12:18
 
Ответить
Сообщениекстати, теперь вы можете менять положение черного и белого, а также расположение чисел. Лишь бы последовательность 1-25 в чёрном присутствовала.
Жёсткой привязки к адресам больше нет!
Автор - Апострофф
Дата добавления - 01.07.2020 в 12:17
ivstepa Дата: Среда, 01.07.2020, 12:49 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 6 ±
Замечаний: 0% ±

Excel 2016
Вставил ваш код, нажимаю на 1 - копируется и все, остальное не хочет, что не так.
Ругается на If Target = T + 1 Then
runtime error 13
type mismatch
У меня с макросами туговато.
 
Ответить
СообщениеВставил ваш код, нажимаю на 1 - копируется и все, остальное не хочет, что не так.
Ругается на If Target = T + 1 Then
runtime error 13
type mismatch
У меня с макросами туговато.
Автор - ivstepa
Дата добавления - 01.07.2020 в 12:49
Апострофф Дата: Среда, 01.07.2020, 13:03 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
Global T&
первой строкой в Module1 поставили?
 
Ответить
СообщениеGlobal T&
первой строкой в Module1 поставили?
Автор - Апострофф
Дата добавления - 01.07.2020 в 13:03
Апострофф Дата: Среда, 01.07.2020, 13:07 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
В файле -
К сообщению приложен файл: 6848664_v2.xlsm (19.1 Kb)
 
Ответить
СообщениеВ файле -
Автор - Апострофф
Дата добавления - 01.07.2020 в 13:07
ivstepa Дата: Среда, 01.07.2020, 13:15 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 6 ±
Замечаний: 0% ±

Excel 2016
Спасибо большое то что надо.
А не подскажете еще, если, например, надо будет в обратном порядке и на другом фоне - на красном.
 
Ответить
СообщениеСпасибо большое то что надо.
А не подскажете еще, если, например, надо будет в обратном порядке и на другом фоне - на красном.
Автор - ivstepa
Дата добавления - 01.07.2020 в 13:15
Апострофф Дата: Среда, 01.07.2020, 13:22 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
А как мы будем догадываться - считаем вперёд по чёрному или назад по красному?
 
Ответить
СообщениеА как мы будем догадываться - считаем вперёд по чёрному или назад по красному?
Автор - Апострофф
Дата добавления - 01.07.2020 в 13:22
ivstepa Дата: Среда, 01.07.2020, 14:01 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 6 ±
Замечаний: 0% ±

Excel 2016
Я имел виду, что изменить в коде если необходимо создать другую таблицу, с другими условиями.
 
Ответить
СообщениеЯ имел виду, что изменить в коде если необходимо создать другую таблицу, с другими условиями.
Автор - ivstepa
Дата добавления - 01.07.2020 в 14:01
Апострофф Дата: Среда, 01.07.2020, 14:28 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
+ поменяйте на - , 0 на 25 или 255 в нужных местах. И ВСЁ!!!
 
Ответить
Сообщение+ поменяйте на - , 0 на 25 или 255 в нужных местах. И ВСЁ!!!
Автор - Апострофф
Дата добавления - 01.07.2020 в 14:28
ivstepa Дата: Среда, 01.07.2020, 14:40 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 6 ±
Замечаний: 0% ±

Excel 2016
Я извиняюсь, но для меня это темный лес. Как сделать красный от 24 до 1, меняю но ничего. Что отвечает за цвет?
 
Ответить
СообщениеЯ извиняюсь, но для меня это темный лес. Как сделать красный от 24 до 1, меняю но ничего. Что отвечает за цвет?
Автор - ivstepa
Дата добавления - 01.07.2020 в 14:40
Апострофф Дата: Среда, 01.07.2020, 14:46 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
[vba]
Код
Лист1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Interior.Color = 255 Then
  If Target = T - 1 Then
    Target.Copy Cells((T Mod 7) + 1, 9 + (T \ 7))
    T = T - 1
  End If
End If
End Sub

'Module1
Global T&

Sub Очистить()
T = 25
With Range("I1:L7")   '.Select
    With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With .Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    .ClearContents
End With
End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Лист1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Interior.Color = 255 Then
  If Target = T - 1 Then
    Target.Copy Cells((T Mod 7) + 1, 9 + (T \ 7))
    T = T - 1
  End If
End If
End Sub

'Module1
Global T&

Sub Очистить()
T = 25
With Range("I1:L7")   '.Select
    With .Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With .Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    .ClearContents
End With
End Sub
[/vba]
Автор - Апострофф
Дата добавления - 01.07.2020 в 14:46
ivstepa Дата: Среда, 01.07.2020, 15:11 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 6 ±
Замечаний: 0% ±

Excel 2016
Посмотрите что не так?
К сообщению приложен файл: 6177522.xlsm (17.7 Kb)
 
Ответить
СообщениеПосмотрите что не так?
Автор - ivstepa
Дата добавления - 01.07.2020 в 15:11
Апострофф Дата: Среда, 01.07.2020, 15:18 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
не знаете чем отличается модуль листа и общий модуль?
К сообщению приложен файл: 6848664_v3.xlsm (17.4 Kb)


Сообщение отредактировал Апострофф - Среда, 01.07.2020, 16:27
 
Ответить
Сообщениене знаете чем отличается модуль листа и общий модуль?
Автор - Апострофф
Дата добавления - 01.07.2020 в 15:18
ivstepa Дата: Четверг, 02.07.2020, 08:00 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 6 ±
Замечаний: 0% ±

Excel 2016
Спасибо большое за помощь, очень Вам благодарен.
 
Ответить
СообщениеСпасибо большое за помощь, очень Вам благодарен.
Автор - ivstepa
Дата добавления - 02.07.2020 в 08:00
Апострофф Дата: Четверг, 02.07.2020, 22:47 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 458
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
Обращайтесь есчо, мы рады помогать ...
 
Ответить
СообщениеОбращайтесь есчо, мы рады помогать ...
Автор - Апострофф
Дата добавления - 02.07.2020 в 22:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » При клике по ячейке, скопировать её содержимое в другую (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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