Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удалить строки из умной таблицы vba
 
#1
17.11.2022 15:11:30
Добрый день!
Помогите, пожалуйста, удалить все строки из умной таблицы!
Код
tbl.DataBodyRange.Delete

Вот этот код очищает их, а мне бы удалить совсем или сделать resize в меньшую сторону
 
 
 
#2
17.11.2022 15:16:12
А макрорекодером пользоваться не пробовали?
Скажи мне, кудесник, любимец ба’гов...
 
 
 
#3
17.11.2022 15:21:08
В крайнем случае можно. Неужели иначе никак?
 
 
 
#4
17.11.2022 15:35:57
Не
Цитата
Елена Дроздова написал:
В крайнем случае можно
, а почти всегда, когда что-то непонятно. Записали, посмотрели код, переписали нужные куски себе в рукописный макрос. Автозаписанное стерли
Скажи мне, кудесник, любимец ба’гов...
 
 
 
#5
17.11.2022 15:38:01
Мне не помогло(
 
 
 
#6
17.11.2022 15:56:31
Цитата
написал:
Мне не помогло(
А Вы тестируете на таблице с одной строкой?
 
 
 
#7
17.11.2022 16:10:57
МатросНаЗебре, я уже по-разному пробовала.
Сейчас дошла до того, чтобы удалять построчно в цикле do while... loop, пока количество строк в таблице не станет равно 1. Проблема состоит теперь в том, что когда остается одна строка, возникает ошибка.
Код
    Do While lastrow1 > 1
        Set ListRow = tbl.ListRows(1)
        ListRow.Delete
    Loop
Изменено: Елена Дроздова - 17.11.2022 16:11:38
 
 
 
#8
17.11.2022 16:14:46
Вы берете таблицу, в которой 3 строки.
Запускаете код
Код
tbl.DataBodyRange.Delete
И строки не удаляются?
Или строки удаляются, но остаётся одна пустая строка?
 
 
 
#9
17.11.2022 16:16:25
МатросНаЗебре, строки не удаляются. Они очищаются, но размер таблицы остается прежним
 
 
 
#10
17.11.2022 16:23:18
И еще затык: если в таблице одна пустая строка, макрос не может посчитать количество строк в таблице
 
 
 
#11
17.11.2022 16:26:44
А приложите два скрина. До и после.
 
 
 
#12
17.11.2022 16:32:16
У меня макрос должен удалить существующие строки в умной таблице, а затем заполнить ее. Заполняет он строки верно, но вместо удаления строк он их очищает и начинает заполнение со следующей (новой) строки.
До: https://prnt.sc/mZSygw4JkciK
После: https://prnt.sc/HBbA3D-MFf4_
Изменено: Елена Дроздова - 17.11.2022 16:34:41
 
 
 
#13
17.11.2022 16:34:12
А можно весь код макроса посмотреть?
Изменено: МатросНаЗебре - 17.11.2022 16:34:37
 
 
 
#14
17.11.2022 16:35:04
Код
Sub Переработки()
    
    Dim tbl As Object
    Dim lastrow, lastrow1, lastrow2, lastcol As Integer
    Dim i, j As Integer
    Dim tip, fio, data, ob, vid, vr As Variant
    Dim mes As Integer
    Dim ListRow As ListRow
    
    Set tbl = Workbooks("Люди.xlsm").Sheets("Переработки").ListObjects("Переработка")
    mes = Workbooks("Люди.xlsm").Sheets("Табель").Range("B1").Value
    lastrow = Workbooks("Люди.xlsm").Sheets("Табель").Cells(Rows.Count, 1).End(xlUp).Row
    lastrow1 = tbl.DataBodyRange.Rows.Count
    tbl.DataBodyRange.Delete
    
    lastrow2 = Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Rows.Count + 1
    lastcol = Workbooks("Люди.xlsm").Sheets("Табель").Cells(3, Columns.Count).End(xlToLeft).Column
    
    For i = 4 To lastrow
        For j = 6 To lastcol
            If Workbooks("Люди.xlsm").Sheets("Табель").Cells(i, j).Interior.Color = vbYellow Then
                lastrow1 = lastrow1 + 1
                fio = Workbooks("Люди.xlsm").Sheets("Табель").Cells(i, 2)
                data = CDate(Workbooks("Люди.xlsm").Sheets("Табель").Cells(3, j) & "." & mes & ".2022")
                If Workbooks("Люди.xlsm").Sheets("Табель").Cells(3, j).Interior.Color = vbGreen Then
                    tip = "выходной"
                    vr = Workbooks("Люди.xlsm").Sheets("Табель").Cells(i, j)
                Else
                    tip = "рабочий"
                    vr = Workbooks("Люди.xlsm").Sheets("Табель").Cells(i, j) - 8
                End If
                Call Значения(lastrow2, tip, fio, data, ob, rab)
                Call Переработки_заполнить(tbl, lastrow1, fio, data, ob, rab, vr)
            End If
        Next j
    Next i
    MsgBox ("Переработки сформированы согласно табелю за " & mes & ".2022 г.")
End Sub

Private Sub Значения(last, tip, fio, data, ob, rab)
    Dim a, b As Integer
    Dim arr_ob() As Variant
    Dim arr_rab() As Variant
    Erase arr_ob
    Erase arr_rab
    b = 0
    If tip = "выходной" Then
        For a = 2 To lastrow2
            If Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 1) = data And Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 3) = fio Then
                ob = Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 8)
                rab = Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 9)
            End If
        Next a
    Else
        For a = 2 To last
            If Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 1) = data And Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 3) = fio And Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 7) > 8 Then
                ob = Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 8)
                rab = Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 9)
            Else
                If Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 1) = data And Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 3) = fio And Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 7) <= 8 Then
                    b = b + 1
                    ReDim Preserve arr_ob(0 To b)
                    arr_ob(UBound(arr_ob)) = Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 8)
                    ReDim Preserve arr_rab(0 To b)
                    arr_rab(UBound(arr_rab)) = Workbooks("Люди.xlsm").Sheets("Для заполнения").ListObjects("Заполнение").DataBodyRange.Cells(a, 9)
                    ob = arr_ob(UBound(arr_ob))
                    rab = arr_rab(UBound(arr_rab))
                End If
            End If
        Next a
    End If
End Sub

Private Sub Переработки_заполнить(tbl, str, fio, data, ob, rab, vr)
    tbl.Resize (tbl.Range.Resize(str, 5))
    tbl.DataBodyRange.Cells(str, 1) = fio
    tbl.DataBodyRange.Cells(str, 2) = data
    tbl.DataBodyRange.Cells(str, 3) = ob
    tbl.DataBodyRange.Cells(str, 4) = rab
    tbl.DataBodyRange.Cells(str, 5) = vr
End Sub
 
 
 
#15
17.11.2022 16:44:14
Вместо
Код
    lastrow1 = tbl.DataBodyRange.Rows.Count
    tbl.DataBodyRange.Delete
Напишите
Код
    tbl.DataBodyRange.Delete
    lastrow1 = 1
Вы не о том спрашиваете. Вы спрашиваете "Почему не удаляются?". А нужно "Почему заполняется неправильно?".

PS И, видимо, в Переработки_заполнить DataBodyRange надо заменить на Range.
Изменено: МатросНаЗебре - 17.11.2022 16:52:35 (DataBodyRange надо заменить на Range.)
 
 
 
#16
17.11.2022 16:51:26
Ого, не ожидала...
Но теперь он не заполняет ((
 
 
 
#17
17.11.2022 16:54:07
Ошибка 91? Или просто не заполняет?

Если 91, то замените в Переработки_заполнить DataBodyRange на Range.
 
 
 
#18
17.11.2022 16:57:11
Оно самое. Спасибо огромное!
 
 
 
#19
17.11.2022 18:08:57
Справка по скорости: Resize всегда помогает
Уменьшить им Таблицу, а потом очистить данных вне таблицы намного быстрее удаления строк.
Увеличить Таблицу перед вставкой также заметно ускоряет дело.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#20
18.11.2022 10:56:28
Цитата
написал:
Справка по скорости: Resize всегда помогает
Полезная инфа, запоминаем ).
 
 
 
#21
18.11.2022 15:35:36
Если в умной таблице остается одна пустая строка, то команда
Код
tbl.DataBodyRange.Delete

вызывает ошибку.

Я попробовала добавить обработчик:

Код
    If IsEmpty(tbl.DataBodyRange) Then        tbl.DataBodyRange.Delete    End If

Если в таблице одна пустая строка, то код выполняется, а если нет, то старые данные оказываются вне таблицы, а строка внутри таблицы перезаписывается.

Я, вероятно, чего-то не понимаю, но по моей логике должно быть ровно наоборот)

В итоге, правильно работает (или мне так кажется?) вот этот код, но кто-нибудь может мне объяснить, почему так???  :D

Код
    If Not IsEmpty(tbl.DataBodyRange) Then        tbl.DataBodyRange.Delete    End If
 
 
 
#22
18.11.2022 15:49:57
Цитата
Елена Дроздова написал:
Если в умной таблице остается одна пустая строка
Это не пустая строка. Это фантом. В таблице есть строка заголовков (есть таблица), но нет данных. Проверяйте так
Код
If tbl.DataBodyRange Is Nothing Then  
 
 
 
#23
18.11.2022 16:13:30
RAN, да, так тоже работает и выглядит логичнее. Спасибо!
 
 
 
#24
18.11.2022 17:26:34
Цитата
RAN: If tbl.DataBodyRange Is Nothing Then
или If tbl.DataBodyRange.Rows.Count =0 Then

UPD от 21/11/2022:
этот способ нерабочий, т.к. вызовет ошибку при пустой Таблице
Изменено: Jack Famous - 21.11.2022 11:36:46
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх