Страницы: 1
RSS
Как сделать изменение текста в ячейке через диалог (как в обычной программе) чтобы избежать случайного изменения или стирания
 
Приветствую и прошу помощи у специалистов с большой буквы.

Есть эксель любая таблица.
Надо придумать решение чтобы в стандартную ячейку можно вписать текст только через окошко доп диалога. Либо пишем в одну ячейку, жмем что-то, происходит записывание того что вписали куда-то рядом, и это до момента пока опять не исправим и не перенажмём Записать.

А если ячейка еще пустая пока, то вписывать просто как обычно, сразу. Но это уже как получится.
Кто что знает?


Прошу подсказать простой способ, не через макросы, если совсем никак по-простому не выйдет - то как это сделать через макрос, может кнопку к каждой ячейке рядом поставить, это уже не важно если совсем никак. Можно, как писал выше, рядом в ячейку пишем, жмем что-то и где надо меняется.

Красота особо не играет роли. В таблице можно ставить правее любые кнопки. она не ограничена ничем.

Для внутренних нужд.
 
Проверка данных
Согласие есть продукт при полном непротивлении сторон
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vv As Variant
    vv = Target.Cells(1, 1).Value
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    vv = InputBox("Введите значение", "окошко доп диалога", vv)
    If vv = "" Then vv = Empty
    Application.EnableEvents = False
    Target.Value = vv
    Application.EnableEvents = True
End Sub
В модуль листа.
 
МатросНаЗебре, это просто супер.

А может можно сделать ввод данных через такое чудо-окошко только в те ячейки где это необходимо?
а все другие пусть как будут.
Или, как идея, на листе указать в вашем коде какую-то верхнюю часть листа или область (лучше область с и по) где все ячейки меняются по такому принципу, а все остальное как всегда?

Конечно можно выйти из положения и для супер важных данных сделать лист отдельный. Это я смекнул уже, но все же.

Весь лист это идеально, но это через-чур :)))
Изменено: Profan007 - 15.01.2025 16:37:07
 
Цитата
написал:
только в те ячейки где это необходимо
"A1:B2" - замените на адрес так необходимый)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:B2")) Is Nothing Then Exit Sub
    Dim vv As Variant
    vv = Target.Cells(1, 1).Value
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    vv = InputBox("Введите значение " & Target.Address(0, 0, xlA1), "окошко доп диалога", vv)
    If vv = "" Then vv = Empty
    Application.EnableEvents = False
    Target.Value = vv
    Application.EnableEvents = True
End Sub
 
Цитата
написал:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("A1:B2")) Is Nothing Then Exit Sub
   Dim vv As Variant
   vv = Target.Cells(1, 1).Value
   Application.EnableEvents = False
   Application.Undo
   Application.EnableEvents = True
   vv = InputBox("Введите значение " & Target.Address(0, 0, xlA1), "окошко доп диалога", vv)
   If vv = "" Then vv = Empty
   Application.EnableEvents = False
   Target.Value = vv
   Application.EnableEvents = True
End Sub


Прошу прощения, простым докопированием строки     If Intersect(Target, Range("A5:B9")) Is Nothing Then Exit Sub
ничего не работает. все разрушилось.

Как сделать чтобы можно было разные диапазоны в разных местах сделать?
Изменено: Profan007 - 15.01.2025 16:56:22
 
Код
If Intersect(Target, Range("A1:B2")) Is Nothing And Intersect(Target, Range("C3:D4")) Is Nothing Then Exit Sub
или
If Intersect(Target, Union(Range("A1:B2"), Range("C3:D4"))) Is Nothing Then Exit Sub
 
Огромное спасибо

пс: Заметил такую особенность, при использовании такого скрипта, эксель не помнит что было в этой ячеке до изменения.
Т.е. мы не можем изменить три раза на что-то одну и ту же ячейку через диалог, и потом стрелочками назад отменить 2 раза исправления. Первое значение не появится !!!
Эксель просто оставит пустую клетку.
Кто будет использовать это скрипт - имейте ввиду.

Вопрос к Автору скрипта, Это нормально? как запомнить значения? или это нереально?
Изменено: Profan007 - 15.01.2025 18:06:01
 
Это нормально. Например, сохранить на вспомогательных листах. Это реально.
 
Цитата
Profan007 написал:
как запомнить значения? или это нереально?
сохранить значения можно, а вот многократный пошаговый откат на предыдущее значение - уже проблемно :)
Для примера: Как отменить действия макроса
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    CellUndo Target
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rr As Range
    Set rr = Range("A1:B2,C3:D4,F7")
    
    Set rr = Intersect(rr, rr.Parent.UsedRange)
    If Intersect(Target, rr) Is Nothing Then Exit Sub
    Dim vv As Variant
    vv = Target.Cells(1, 1).Value
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    vv = InputBox("Введите значение " & Target.Address(0, 0, xlA1), "окошко доп диалога", vv)
    If vv = "" Then vv = Empty
    Application.EnableEvents = False
    Target.Value = vv
    Application.EnableEvents = True
    
    SaveUndo Target
End Sub

'----------------------------- Желательно в стандартный модуль ------------------------------------------------------------------------
Sub Вернуть()
    CellRedo ActiveCell
End Sub

Sub Отменить()
    CellUndo ActiveCell
End Sub

Public Sub SaveUndo(rSource As Range)
    Const MAX_COLUMN = 100
    With GetSheetUndo()
        Dim cl As Range, yu As Long, xu As Long
        For Each cl In rSource.Cells
            On Error Resume Next
            yu = WorksheetFunction.Match(CellKey(cl), .Columns(1), 0)
            On Error GoTo 0
            If yu = 0 Then
                yu = .UsedRange.Row + .UsedRange.Rows.Count
                .Cells(yu, 1).Value = CellKey(cl)
                .Cells(yu, 2).Value = 3
            End If
            xu = .Cells(yu, .Columns.Count).End(xlToLeft).Column + 1
            If .Cells(yu, xu - 1).Value <> cl.Value Or xu = 3 Then
                .Cells(yu, xu).Value = cl.Value
                .Cells(yu, 2).Value = xu
                If xu >= MAX_COLUMN Then
                    .Cells(yu, 3).Resize(1, MAX_COLUMN).Value = .Cells(yu, 4).Resize(1, MAX_COLUMN).Value
                    .Cells(yu, 2).Value = .Cells(yu, .Columns.Count).End(xlToLeft).Column + 1
                End If
            End If
        Next
    End With
End Sub

Public Sub CellUndo(cl As Range)
    CellUndoRedo -1, cl
End Sub

Public Sub CellRedo(cl As Range)
    CellUndoRedo 1, cl
End Sub

Private Sub CellUndoRedo(iMode As Long, cl As Range)
    With GetSheetUndo()
        Dim yu As Long
        On Error Resume Next
        yu = WorksheetFunction.Match(CellKey(cl), .Columns(1), 0)
        On Error GoTo 0
        If yu = 0 Then Exit Sub
        
        Dim xu As Long
        xu = .Cells(yu, 2).Value
        xu = xu + iMode
        If xu <= 2 Then Exit Sub
        If xu > .Cells(yu, .Columns.Count).End(xlToLeft).Column Then Exit Sub
        Application.EnableEvents = False
        cl.Value = .Cells(yu, xu).Value
        Application.EnableEvents = True
        .Cells(yu, 2).Value = xu
    End With
End Sub

Private Function CellKey(cl As Range) As String
    CellKey = cl.Address(0, 0, xlA1)
End Function

Private Function GetSheetUndo() As Worksheet
    Const SHEET_NAME = "undo"
    Dim sh As Worksheet
    On Error Resume Next
    Set sh = Sheets(SHEET_NAME)
    On Error GoTo 0
    If sh Is Nothing Then
        Dim shActive As Worksheet
        Set shActive = ActiveSheet
        Set sh = Sheets.Add(After:=shActive)
        shActive.Activate
        sh.Name = SHEET_NAME
        sh.Visible = xlSheetHidden
    End If
    Set GetSheetUndo = sh
End Function
Изменено: МатросНаЗебре - 16.01.2025 10:12:06 (Const MAX_COLUMN = 100)
 
Простите пожалуйста,

это все скопировать в макрос?

или что значит часть (Желательно в стандартный модуль)  Это куда вставить?
Эту часть оторвать и вставить куда-то в другое место?

то как у вас, разом вставить в МАКРОСЫ - не сохраняет историю. Вернуть что-то назад - нельзя почему-то.
видимо я что-то не так делаю.
Изменено: Profan007 - 18.01.2025 00:40:57
 
Про модули почитать можно тут. Создание макросов и пользовательских функций на VBA
Достаточно пункта 1. Учтите в статье "обычные модули" = "стандартные модули".

Цитата
написал:
Вернуть что-то назад - нельзя почему-то.
С помощью этих макросов можно вернуть только значения указанных диапазонов. Форматирование, значения других диапазонов и прочее этими макросами не возвращаются.
 
Спасибо. Будем изучать и применять.
Страницы: 1
Наверх