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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос удаления значений из диапазона по вводу списка - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос удаления значений из диапазона по вводу списка (Макросы/Sub)
Макрос удаления значений из диапазона по вводу списка
svetonosniy Дата: Четверг, 21.12.2017, 08:22 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Доброго времени суток! Не могу найти нужную информацию, честно облазил весь форум. Требуется решить следующую задачу: имеется файл со множеством значений в одном столбце. Нужен макрос, который будет из выделенного диапазона удалять значения, которые введены или где либо заданы (ввод удаляемых значений может быть любым). На примере: в файле столбец B имеет множество значений, для простоты введем следующие:
значение 1
значение 2
значение 3
значение 2_1
значение 3_2
значение 1_3
значение 2_2
значение 3_1

В один прекрасный день появилась необходимость среди них из диапазона со строки 2 по строку 8 найти удалить следующие:
значение 3
значение 1_3

Нужен именно макрос, так как значений около 20000, требуется удалять штук по 50 из диапазонов, содержащих 100-1000 значений

Очень надеюсь на вашу помощь! В примере файла думаю смысла нет, но прикреплю на всякий случай то, что описал вsit
К сообщению приложен файл: 2569766.xlsx(9.6 Kb)
 
Ответить
СообщениеДоброго времени суток! Не могу найти нужную информацию, честно облазил весь форум. Требуется решить следующую задачу: имеется файл со множеством значений в одном столбце. Нужен макрос, который будет из выделенного диапазона удалять значения, которые введены или где либо заданы (ввод удаляемых значений может быть любым). На примере: в файле столбец B имеет множество значений, для простоты введем следующие:
значение 1
значение 2
значение 3
значение 2_1
значение 3_2
значение 1_3
значение 2_2
значение 3_1

В один прекрасный день появилась необходимость среди них из диапазона со строки 2 по строку 8 найти удалить следующие:
значение 3
значение 1_3

Нужен именно макрос, так как значений около 20000, требуется удалять штук по 50 из диапазонов, содержащих 100-1000 значений

Очень надеюсь на вашу помощь! В примере файла думаю смысла нет, но прикреплю на всякий случай то, что описал вsit

Автор - svetonosniy
Дата добавления - 21.12.2017 в 08:22
китин Дата: Четверг, 21.12.2017, 09:05 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4766
Репутация: 763 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
как то так, наверное. то что удалять в желтой ячейке(выпадающий список) . и нажать кнопочку
[vba]
Код
Sub TTT()
Dim Lr&, i&
Lr = Cells(Rows.Count, 3).End(xlUp).Row
    For i = Lr To 2 Step -1
        If Cells(i, 3).Value = Cells(1, 6).Value Then
            Range("C" & i).Delete Shift:=xlUp
        End If
     Next
End Sub
[/vba]
К сообщению приложен файл: _2569766.xlsm(19.9 Kb)


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538


Сообщение отредактировал китин - Четверг, 21.12.2017, 09:05
 
Ответить
Сообщениекак то так, наверное. то что удалять в желтой ячейке(выпадающий список) . и нажать кнопочку
[vba]
Код
Sub TTT()
Dim Lr&, i&
Lr = Cells(Rows.Count, 3).End(xlUp).Row
    For i = Lr To 2 Step -1
        If Cells(i, 3).Value = Cells(1, 6).Value Then
            Range("C" & i).Delete Shift:=xlUp
        End If
     Next
End Sub
[/vba]

Автор - китин
Дата добавления - 21.12.2017 в 09:05
svetonosniy Дата: Четверг, 21.12.2017, 09:35 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
китин, спасибо, похоже, но не совсем, я наверное немного не так выразился. Удалять надо не поштучно, а списком, массивом. Указывать массив - и чтобы удалялись перечисленные значения при совпадении с диапазоном имеющихся значений
 
Ответить
Сообщениекитин, спасибо, похоже, но не совсем, я наверное немного не так выразился. Удалять надо не поштучно, а списком, массивом. Указывать массив - и чтобы удалялись перечисленные значения при совпадении с диапазоном имеющихся значений

Автор - svetonosniy
Дата добавления - 21.12.2017 в 09:35
sboy Дата: Четверг, 21.12.2017, 10:39 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1689
Репутация: 479 ±
Замечаний: 0% ±

Excel 2010
Подправил макрос Игоря.
Выделяем список для удаления и жмем кнопку
[vba]
Код
Sub TTT()
Dim arr_() ' переменная массив значений для удаления
Application.ScreenUpdating = False
Set r = Selection
    If Not r Is Nothing Then
        If r.Count = 1 Then 'если выделена 1 ячейка
            ReDim arr_(1 To 1, 1 To 1) ' объявляем двумерный массив 1 на 1 для работы цикла ниже
            arr_(1, 1) = r.Value ' записываем единственное значение
        Else: arr_ = r.Value  ' если выделено больше 1 ячейки, то записываем значения в массив
        End If
        For x = 1 To UBound(arr_) 'цикл по элементам массива
            For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1 'цикл по строкам где надо удалять
                If Cells(i, 3).Value = arr_(x, 1) Then Range("C" & i).Delete Shift:=xlUp 'если значение из массива совпадает с ячейкой - удаляем
            Next i
        Next x
    End If
Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 4106102.xlsm(21.2 Kb)


Сообщение отредактировал sboy - Четверг, 21.12.2017, 11:27
 
Ответить
СообщениеПодправил макрос Игоря.
Выделяем список для удаления и жмем кнопку
[vba]
Код
Sub TTT()
Dim arr_() ' переменная массив значений для удаления
Application.ScreenUpdating = False
Set r = Selection
    If Not r Is Nothing Then
        If r.Count = 1 Then 'если выделена 1 ячейка
            ReDim arr_(1 To 1, 1 To 1) ' объявляем двумерный массив 1 на 1 для работы цикла ниже
            arr_(1, 1) = r.Value ' записываем единственное значение
        Else: arr_ = r.Value  ' если выделено больше 1 ячейки, то записываем значения в массив
        End If
        For x = 1 To UBound(arr_) 'цикл по элементам массива
            For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1 'цикл по строкам где надо удалять
                If Cells(i, 3).Value = arr_(x, 1) Then Range("C" & i).Delete Shift:=xlUp 'если значение из массива совпадает с ячейкой - удаляем
            Next i
        Next x
    End If
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - sboy
Дата добавления - 21.12.2017 в 10:39
svetonosniy Дата: Четверг, 21.12.2017, 10:44 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
sboy, кажется то что надо! Спасибо, буду тестировать!
 
Ответить
Сообщениеsboy, кажется то что надо! Спасибо, буду тестировать!

Автор - svetonosniy
Дата добавления - 21.12.2017 в 10:44
китин Дата: Четверг, 21.12.2017, 11:10 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4766
Репутация: 763 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
Сергей а прокомментировать код можно?
pray pray pray


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
СообщениеСергей а прокомментировать код можно?
pray pray pray

Автор - китин
Дата добавления - 21.12.2017 в 11:10
sboy Дата: Четверг, 21.12.2017, 11:28 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 1689
Репутация: 479 ±
Замечаний: 0% ±

Excel 2010
Игорь, написал в коде из сообщения выше
 
Ответить
СообщениеИгорь, написал в коде из сообщения выше

Автор - sboy
Дата добавления - 21.12.2017 в 11:28
nilem Дата: Четверг, 21.12.2017, 12:48 | Сообщение № 8
Группа: Авторы
Ранг: Старожил
Сообщений: 1441
Репутация: 508 ±
Замечаний: 0% ±

Excel 2013
Вариант:
[vba]
Код
Sub ttt()
Dim arr
With Range("F1", Cells(Rows.Count, 6).End(xlUp))
    arr = Application.Transpose(.Value)
End With
With Range("C1", Cells(Rows.Count, 3).End(xlUp))
    .AutoFilter 1, arr, 7
    .Offset(1).Delete Shift:=xlUp
    .AutoFilter
End With
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеВариант:
[vba]
Код
Sub ttt()
Dim arr
With Range("F1", Cells(Rows.Count, 6).End(xlUp))
    arr = Application.Transpose(.Value)
End With
With Range("C1", Cells(Rows.Count, 3).End(xlUp))
    .AutoFilter 1, arr, 7
    .Offset(1).Delete Shift:=xlUp
    .AutoFilter
End With
End Sub
[/vba]

Автор - nilem
Дата добавления - 21.12.2017 в 12:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос удаления значений из диапазона по вводу списка (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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