Страницы: 1
RSS
Удаление данных из выпадающего списка умной таблицы по нажатию на кнопку.
 
На Листе2 имеется список в "Умной таблице" (Ctrl+T) (Таблица 1 ). В этой таблице создан диапазон "Фамилии" (Формулы - Диспетчер имен). На странице 1 созданы выпадающие списки. И добавлен скрипт для добавления сотрудника в умную таблицу  на Листе2, по примеру с форума https://www.planetaexcel.ru/techniques/1/35/index.php?page=user&id=11. Необходимо создать форму удаления сотрудника из умной таблицы, да так что бы умная таблица уменьшалась на 1 ячейку.  Например в ячейке D1 выпадающий список. Выбираем фамилию и удаляем нажатием кнопки из умной таблицы на листе 2.

Сам скрипт добавления и сортировки.
Код
Private Sub Worksheet_Change(ByVal Target As Range)

Dim lReply As Long

    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A1:A42")) Is Nothing Then
            If IsEmpty(Target) Then Exit Sub
                If WorksheetFunction.CountIf(Sheets("Лист2").Range("Фамилии"), Target) = 0 Then
                    lReply = MsgBox("новый сотрудник " & Target & " ,добавить?", vbYesNo + vbQuestion)
                        If lReply = vbYes Then
                            Worksheets("Лист2").Range("Фамилии").Cells(Worksheets("Лист2").Range("Фамилии").Rows.Count + 1, 1) = Target
                        End If
                End If
        End If
      Sheets("Лист2").Range("Фамилии").Sort Key1:=Sheets("Лист2").Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal 'this cod will help to range your stores
End Sub
 
Добрый день
Не перестаю удивляться возможностям excel и VBA.
 
Потрясающе!!!!!!!!!! КОМПРЭСИЯ!!!!!!!!! ****эмоции*****  :D  Спасибо Вам большое!!!!  
 
Да не за что) там не сложный макрос.  
Не перестаю удивляться возможностям excel и VBA.
 
Однако, если добавить еще одну таблицу на Лист2, макрос перестает работать. Подскажите как исправить?
 
Смотрите, все просто, как я говорил.
Код
Sub RowDel() 'найти и удалить строку
Dim Удалить As String, RowDel As Long
'что найти:
Удалить = Range("D1")
'Ищем это в столбце А на листе2 и запоминаем номер строки(RowDel). Если не нашел(ошибка) - идем дальше.
On Error Resume Next: RowDel = Worksheets("Лист2").Range("A:A").Find(Удалить, , xlFormulas, xlWhole, , , 0, 0).Row
'Если нет номера строки(ошибка) идем дальше, а если номер строки есть - удаляем эту строку
On Error Resume Next: Worksheets("Лист2").Rows(RowDel).Delete
End Sub 

Не совсем конечно по Вашим условиям, но результат достигнут)

Он не перестал работать. Но если еще одну таблицу добавить справа, то она также будет уменьшаться на 1 строчку, а это наврали Вам нужно.

Какую роль играет еще одна таблица на втором листе? М.б. проще ее создать на листе3? Можно пример, и над ним подумаем.

Изменено: Shama - 03.02.2021 19:53:40
Не перестаю удивляться возможностям excel и VBA.
 
Спасибо за разъяснение. Воспользуюсь Вашим советом.
Страницы: 1
Наверх