Добрый день. Прошу вашей помощи, ничего самостоятельно найти не смог. Суть. Можно ли в таблице (см. файл) сделать "кнопку" (Добавить) при нажатии на которую вся информация справа от нее сдвигалась на две ячейки. Если еще и проверка будет от двойного нажатия (проверить есть ли записи в ячейке) будет вообще супер. Нужно что бы последняя запись была всегда слева, записывать часто приходится. В файле: 1 - как выглядит до нажатия до нажатия на "кнопку" 2 - после нажатия.
Добрый день. Прошу вашей помощи, ничего самостоятельно найти не смог. Суть. Можно ли в таблице (см. файл) сделать "кнопку" (Добавить) при нажатии на которую вся информация справа от нее сдвигалась на две ячейки. Если еще и проверка будет от двойного нажатия (проверить есть ли записи в ячейке) будет вообще супер. Нужно что бы последняя запись была всегда слева, записывать часто приходится. В файле: 1 - как выглядит до нажатия до нажатия на "кнопку" 2 - после нажатия.Xelit
МВТ, спасибо, а можно попросить Вас поправить так, чтобы только в этой строке ячейки сдвигались, а не по всему листу. Сверху и снизу будут записи которые двигать не нужно пока не потребуется дописать новые данные,и применить макрос.
МВТ, спасибо, а можно попросить Вас поправить так, чтобы только в этой строке ячейки сдвигались, а не по всему листу. Сверху и снизу будут записи которые двигать не нужно пока не потребуется дописать новые данные,и применить макрос.Xelit
StoTisteg,прошу прощения, за то что не очень понятно получилось описать суть. В файлике два шага: 1-исходные данные, 2-как должно быть после применения макроса. Сдвигаться ячейки вправо должны только в строке (стол), в соседних (сверху и снизу) остаться на местах. В следующий раз может потребоваться в другие строки записи делать или в ней же и уже там сдвигать. Поэтому я и попросил если возможно сделать в каждой строке "кнопку" (между наименованием и датой, которую потом можно будет протянуть по всей таблице) нажимая на которую, происходил бы сдвиг на две ячейки в выбранной строке, но если и через горячую клавишу макрос будет работать, после того как выделяешь ячейку в строке, где нужен "сдвиг", всё лучше чем сейчас приходится в "ручную" сдвигать. P.S.Надеюсь не запутал вас еще больше.
StoTisteg,прошу прощения, за то что не очень понятно получилось описать суть. В файлике два шага: 1-исходные данные, 2-как должно быть после применения макроса. Сдвигаться ячейки вправо должны только в строке (стол), в соседних (сверху и снизу) остаться на местах. В следующий раз может потребоваться в другие строки записи делать или в ней же и уже там сдвигать. Поэтому я и попросил если возможно сделать в каждой строке "кнопку" (между наименованием и датой, которую потом можно будет протянуть по всей таблице) нажимая на которую, происходил бы сдвиг на две ячейки в выбранной строке, но если и через горячую клавишу макрос будет работать, после того как выделяешь ячейку в строке, где нужен "сдвиг", всё лучше чем сейчас приходится в "ручную" сдвигать. P.S.Надеюсь не запутал вас еще больше.Xelit
Понятно. Только кнопки сами не появляются, их ещё кто-то повесить должен Я бы просто обрабатывал двойной клик по содержимому ячейки со словом "сдвиг".
Понятно. Только кнопки сами не появляются, их ещё кто-то повесить должен Я бы просто обрабатывал двойной клик по содержимому ячейки со словом "сдвиг".StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Примерно так, как в примере. В модуле Лист1 лежит код [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer
If MsgBox(prompt:="Сдвинуть ячейки?", Buttons:=vbQuestion + vbYesNo, Title:="Сдвиг ячеек") = vbYes Then 'Запрос подтверждения. Если не нужен, эту и последнюю строки можно закомментировать i = ActiveSheet.UsedRange.Columns.Count 'Запоминаем число столбцов до сдвига With Target.Offset(, 1) If Target.Value = "Сдвиг" And .Value <> "" Then 'Проверяем, есть ли "кнопка" и не было ли сдвига раньше .Insert shift:=xlToRight 'Дважды вставляем ячейку... .Borders.LineStyle = 1 ' ... и восстанавливаем границу .Insert shift:=xlToRight .Borders.LineStyle = 1 Target.Clear 'Убираем "кнопку", чтобы киворукие не сдвинули второй раз Columns(i + 1).Delete 'Убираем лишнее Columns(i + 1).Delete .Activate ' Перемещаемся в соседнюю ячейку End If End With End If ' Если запрос подтверждения не нужен, эту строку можно закомментировать
End Sub
[/vba]
Работает от двойного клика по кнопке с текстом "Сдвиг". Если текст надо изменить, меняете строку [vba]
Код
If Target.Value = "Сдвиг" And .Value <> "" Then
[/vba] на [vba]
Код
If Target.Value = "<Ваш_Текст>" And .Value <> "" Then
[/vba] Сдвиг привязан к "кнопке", т. е. сдвигается всегда то, что справа от неё. Если нужна возможность сдвигать ячейки, где в первом поле Дата пусто, замените [vba]
Код
If Target.Value = "<Ваш_Текст>" And .Value <> "" Then
[/vba] на [vba]
Код
If Target.Value = "<Ваш_Текст>" Then
[/vba] Если "кнопка" не должна исчезать, закомментируйте строку [vba]
Код
Target.Clear
[/vba]
Примерно так, как в примере. В модуле Лист1 лежит код [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer
If MsgBox(prompt:="Сдвинуть ячейки?", Buttons:=vbQuestion + vbYesNo, Title:="Сдвиг ячеек") = vbYes Then 'Запрос подтверждения. Если не нужен, эту и последнюю строки можно закомментировать i = ActiveSheet.UsedRange.Columns.Count 'Запоминаем число столбцов до сдвига With Target.Offset(, 1) If Target.Value = "Сдвиг" And .Value <> "" Then 'Проверяем, есть ли "кнопка" и не было ли сдвига раньше .Insert shift:=xlToRight 'Дважды вставляем ячейку... .Borders.LineStyle = 1 ' ... и восстанавливаем границу .Insert shift:=xlToRight .Borders.LineStyle = 1 Target.Clear 'Убираем "кнопку", чтобы киворукие не сдвинули второй раз Columns(i + 1).Delete 'Убираем лишнее Columns(i + 1).Delete .Activate ' Перемещаемся в соседнюю ячейку End If End With End If ' Если запрос подтверждения не нужен, эту строку можно закомментировать
End Sub
[/vba]
Работает от двойного клика по кнопке с текстом "Сдвиг". Если текст надо изменить, меняете строку [vba]
Код
If Target.Value = "Сдвиг" And .Value <> "" Then
[/vba] на [vba]
Код
If Target.Value = "<Ваш_Текст>" And .Value <> "" Then
[/vba] Сдвиг привязан к "кнопке", т. е. сдвигается всегда то, что справа от неё. Если нужна возможность сдвигать ячейки, где в первом поле Дата пусто, замените [vba]
Код
If Target.Value = "<Ваш_Текст>" And .Value <> "" Then
[/vba] на [vba]
Код
If Target.Value = "<Ваш_Текст>" Then
[/vba] Если "кнопка" не должна исчезать, закомментируйте строку [vba]
Прошу пардону, забыл восстановить границы бывшей "кнопки". Добавилась одна строчка. [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer
If MsgBox(prompt:="Сдвинуть ячейки?", Buttons:=vbQuestion + vbYesNo, Title:="Сдвиг ячеек") = vbYes Then 'Запрос подтверждения. Если не нужен, эту и последнюю строки можно закомментировать i = ActiveSheet.UsedRange.Columns.Count 'Запоминаем число столбцов до сдвига With Target.Offset(, 1) If Target.Value = "Сдвиг" And .Value <> "" Then 'Проверяем, есть ли "кнопка" и не было ли сдвига раньше .Insert shift:=xlToRight 'Дважды вставляем ячейку... .Borders.LineStyle = 1 ' ... и восстанавливаем границу .Insert shift:=xlToRight .Borders.LineStyle = 1 Target.Clear 'Убираем "кнопку", чтобы киворукие не сдвинули второй раз Columns(i + 1).Delete 'Убираем лишнее Columns(i + 1).Delete Target.Borders.LineStyle = 1 'Восстанавливаем границу в "кнопке" .Activate ' Перемещаемся в соседнюю ячейку End If End With End If ' Если запрос подтверждения не нужен, эту строку можно закомментировать
End Sub
[/vba]
Прошу пардону, забыл восстановить границы бывшей "кнопки". Добавилась одна строчка. [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer
If MsgBox(prompt:="Сдвинуть ячейки?", Buttons:=vbQuestion + vbYesNo, Title:="Сдвиг ячеек") = vbYes Then 'Запрос подтверждения. Если не нужен, эту и последнюю строки можно закомментировать i = ActiveSheet.UsedRange.Columns.Count 'Запоминаем число столбцов до сдвига With Target.Offset(, 1) If Target.Value = "Сдвиг" And .Value <> "" Then 'Проверяем, есть ли "кнопка" и не было ли сдвига раньше .Insert shift:=xlToRight 'Дважды вставляем ячейку... .Borders.LineStyle = 1 ' ... и восстанавливаем границу .Insert shift:=xlToRight .Borders.LineStyle = 1 Target.Clear 'Убираем "кнопку", чтобы киворукие не сдвинули второй раз Columns(i + 1).Delete 'Убираем лишнее Columns(i + 1).Delete Target.Borders.LineStyle = 1 'Восстанавливаем границу в "кнопке" .Activate ' Перемещаемся в соседнюю ячейку End If End With End If ' Если запрос подтверждения не нужен, эту строку можно закомментировать
StoTisteg, спасибо. Все работает, только "кнопку" убирать не нужно, чтобы когда в след раз данные добавлять в строку, снова воспользоваться ей можно было бы. Но благодаря Вашему описанию, сам поправил )))
StoTisteg, спасибо. Все работает, только "кнопку" убирать не нужно, чтобы когда в след раз данные добавлять в строку, снова воспользоваться ей можно было бы. Но благодаря Вашему описанию, сам поправил )))Xelit
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Я бы просто обрабатывал двойной клик по содержимому ячейки со словом "сдвиг".
