Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
По условию удалить строки только умной таблицы, но не удалять строки листа, Vba
 
#1
01.07.2022 06:02:14
Здравствуйте
На листе  параллельно по вертикали две умные таблицы. Как удалить строки только у одной таблицы, не удалив при этом всю строку листа?
В примере условие: удалить строки из второй таблицы месяца Июнь. Месяц в ячейке С1.
НА МЯСО В ПРОФИЛЕ
 
 
 
#2
01.07.2022 06:55:55
 
 
 
#3
01.07.2022 07:08:07
RAN, если вы уточняете, то да. Надо именно - Удалить Строки таблицы.
Только макросом
НА МЯСО В ПРОФИЛЕ
 
 
 
#4
01.07.2022 08:39:35
перед тем, как сделать показанное RAN,  включаете макрорекордер
анализируйте и применяйте полученный код
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
01.07.2022 09:16:28
Ігор Гончаренко, макрорекордером вчера пробовал. Так как две таблицы рядом, то выходит сообщение

Вчера, в принципе создал что то такое рабочее(на другом примере)
Код
Sub Макрос3()
'
' Макрос3 Макрос
'
A = Worksheets("Лист1").[c1000000].End(xlUp).Row
'
    ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1, Criteria1:="b"
    Range("Таблица1").ClearContents
    ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=1
    ActiveWorkbook.Worksheets("Лист1").ListObjects("Таблица1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").ListObjects("Таблица1").Sort.SortFields. _
        Add2 Key:=Range("Таблица1[[#All],[Столбец2]]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").ListObjects("Таблица1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    B = Worksheets("Лист1").[c1000000].End(xlUp).End(xlUp).Row + 1
    Range("C" & B & ":D" & A).Delete
    Range("C10").Select
End Sub


Но хотелось бы профессиональный макрос
НА МЯСО В ПРОФИЛЕ
 
 
 
#6
01.07.2022 09:18:45
Цитата
Михаил Л написал:
макрорекордером вчера пробовал.
Вы не то, что RAN показал, пробовали

Или ниже у Вас есть еще одна таблица
Изменено: _Boroda_ - 01.07.2022 09:20:16
Скажи мне, кудесник, любимец ба’гов...
 
 
 
#7
01.07.2022 10:43:43
D [C1] должна быть дата (первое число месяца)
Код
Sub qq()
    Dim matchRow&, endMatchRow&
    With ActiveWorkbook.Worksheets("Лист1").ListObjects("Таблица13")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range(1), SortOn:=xlSortOnValues, _
                             Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        On Error Resume Next
        matchRow = WorksheetFunction.Match(CDbl(Range("C1")) - 1, .ListColumns(1).Range, 1)
        If Err Then matchRow = 1: Err.Clear
        endMatchRow = WorksheetFunction.Match(CDbl(Application.EoMonth(Range("C1"), 0)), .ListColumns(1).Range, 1) - 1
        .ListRows(matchRow).Range.Resize(endMatchRow - matchRow + 1).Delete
    End With

End Sub
Изменено: RAN - 01.07.2022 10:51:04
 
 
 
#8
01.07.2022 21:59:27
_Boroda_, ниже таблицы нет, только слева таблица.
RAN, Прекрасно работает. Большое спасибо!
НА МЯСО В ПРОФИЛЕ
 
 
 
Страницы: 1
Наверх