Доброго времени суток! Не могу найти нужную информацию, честно облазил весь форум. Требуется решить следующую задачу: имеется файл со множеством значений в одном столбце. Нужен макрос, который будет из выделенного диапазона удалять значения, которые введены или где либо заданы (ввод удаляемых значений может быть любым). На примере: в файле столбец B имеет множество значений, для простоты введем следующие: значение 1 значение 2 значение 3 значение 2_1 значение 3_2 значение 1_3 значение 2_2 значение 3_1
В один прекрасный день появилась необходимость среди них из диапазона со строки 2 по строку 8 найти удалить следующие: значение 3 значение 1_3
Нужен именно макрос, так как значений около 20000, требуется удалять штук по 50 из диапазонов, содержащих 100-1000 значений
Очень надеюсь на вашу помощь! В примере файла думаю смысла нет, но прикреплю на всякий случай то, что описал вsit
Доброго времени суток! Не могу найти нужную информацию, честно облазил весь форум. Требуется решить следующую задачу: имеется файл со множеством значений в одном столбце. Нужен макрос, который будет из выделенного диапазона удалять значения, которые введены или где либо заданы (ввод удаляемых значений может быть любым). На примере: в файле столбец B имеет множество значений, для простоты введем следующие: значение 1 значение 2 значение 3 значение 2_1 значение 3_2 значение 1_3 значение 2_2 значение 3_1
В один прекрасный день появилась необходимость среди них из диапазона со строки 2 по строку 8 найти удалить следующие: значение 3 значение 1_3
Нужен именно макрос, так как значений около 20000, требуется удалять штук по 50 из диапазонов, содержащих 100-1000 значений
Очень надеюсь на вашу помощь! В примере файла думаю смысла нет, но прикреплю на всякий случай то, что описал вsitsvetonosniy
как то так, наверное. то что удалять в желтой ячейке(выпадающий список) . и нажать кнопочку [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]
как то так, наверное. то что удалять в желтой ячейке(выпадающий список) . и нажать кнопочку [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
китин, спасибо, похоже, но не совсем, я наверное немного не так выразился. Удалять надо не поштучно, а списком, массивом. Указывать массив - и чтобы удалялись перечисленные значения при совпадении с диапазоном имеющихся значений
китин, спасибо, похоже, но не совсем, я наверное немного не так выразился. Удалять надо не поштучно, а списком, массивом. Указывать массив - и чтобы удалялись перечисленные значения при совпадении с диапазоном имеющихся значенийsvetonosniy
Подправил макрос Игоря. Выделяем список для удаления и жмем кнопку [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]
Подправил макрос Игоря. Выделяем список для удаления и жмем кнопку [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
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]
Вариант: [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