Страницы: 1
RSS
Как сбросить значения в выпадающих списках до первого значения?
 
Здравствуйте!
Специально зарегистрировался (кстати, это не долго), чтобы спросить помощи у профессионалов.

Ситуация следующая:
На одном листе в книге Excel есть несколько (например, 5) самостоятельных выпадающих списков (эти списки между собой не связаны). В каждом из них есть по несколько (например, по 3) вариантов выбора.

Вопрос:
Как сделать чтобы, при выделении этих списков (например, методом выбора именованного диапазона или просто мышкой), после нажатии клавиши DEL во всех этих списках автоматически выбирался свой первый пункт? На данный момент после нажатии DEL в списках получаются пустые ячейки. Другими словами как сбросить эти списки до первого пункта в каждом из них?

Спасибо!
 
рекордер так сказал:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("c5")) Is Nothing Then
    If [c5] = "" And [d10] = "" And [c16] = "" And [e6] = "" And [g8] = "" Then
    Range("c5").FormulaArray = "=а"
    [c5] = [c5].Value
    Range("d10").FormulaArray = "=б"
    [d10] = [d10].Value
    Range("c16").FormulaArray = "=в"
    [c16] = [c16].Value
    Range("e6").FormulaArray = "=г"
    [e6] = [e6].Value
    Range("g8").FormulaArray = "=д"
    [g8] = [g8].Value
    End If
End If
End Sub
 
в модуль листа:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("все_списки")) Is Nothing Then
    If Target = "" Then
        Application.EnableEvents = False
        ValidationErase
        Application.EnableEvents = True
    End If
End If
End Sub

в стандартный модуль:
Код
Sub ValidationErase()
On Error Resume Next
Dim cel As Range, Rn As Range, Vl$, Val$
    Set Rn = Range("все_списки")
        For Each cel In Rn
            Vl = cel.Validation.Formula1
            If Vl Like "=*" Then
                cel.Value = Range(Replace(Vl, "=", "")).Cells(1).Value
            Else
                cel = Split(Vl, ";")(0) '";" )точка с запятой) - только для русского офиса, если
'                список задан не диапазоном, а перечислением (в примере "С16") -   в других
'                версиях разделитель списка может быть другим (чаще всего - запятая)
            End If
        Next cel
End Sub
 
Вариант. Выделить диапазон - нажать DELETE
Модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Application.OnKey "{DELETE}", "Validatiion_Clear"
    Application.EnableEvents = True
End Sub
Стандартный модуль
Код
Sub Validatiion_Clear()
Dim cl As Range
With Application
    .ScreenUpdating = False
    For Each cl In Selection.Cells
        If Not Intersect(cl, Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then
            cl.Value = Range(Mid(cl.Validation.Formula1, 2))(1).Value
        Else
            cl.ClearContents
        End If
    Next
    .OnKey "{DELETE}", ""
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub
Изменено: Sanja - 01.11.2015 23:24:07
Согласие есть продукт при полном непротивлении сторон
 
Здравствуйте! При изменении в первой колонке любой выбранной строки таблицы, как очистить значение во второй (или правой) колонке?
 
Malkidim,  ваш вопрос какое отношение имеет к данной теме?)) лучше создайте новую
Не бойтесь совершенства. Вам его не достичь.
 
Михаил С., добрый день!

Воспользовалась Вашим решением для схожей задачи. Всё работает, но очень долго "переваривает", посмотрите, пожалуйста, в чём может быть дело.
Задача: очистить голубые ячейки, чтобы значение ячейки стало "-".

PS: Хотела смоделировать файл примера, но там всё отлично и быстро сработало, а в рабочем файле очень долго, поэтому прикреплю сам рабочий файл.
 
Решение.
Код
Sub ValidationErase()
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cel As Range, Rn As Range, Vl$, Val$
    Set Rn = Range("все_списки")
        For Each cel In Rn
            Vl = cel.Validation.Formula1
            If Vl Like "=*" Then
                cel = Range(Replace(Vl, "=", "")).Cells(1).Value
            Else
                cel.Value = Split(Vl, ";")(0)
            End If
        Next cel
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Изменено: skais675 - 05.07.2020 12:06:15
 
skais675,спасибо Вам большое!!!!!!! Так намного лучше!
Страницы: 1
Наверх