Удаление/ Сохранение строк из VBA ListBox

[Bee]

Подскажите пожалуйста,  как строки, не отмеченные галочкой в списке ListBox, удалить с листа Sheet1.

[parovoz]

Может так.

[Bee]

Большое спасибо за ответ, но это не совсем то, что нужно. Задача в том, чтобы после выбора определённых строк в ListBox, остальные (все), Не Отмеченные галочкой строки удалялись (можно было удалить) из списка на листе Sheet1.
Ищу решение.

[parovoz]

Добрый день . Вы в описании  к теме написали :"как строки, не отмеченные галочкой в списке ListBox, удалить с листа Sheet1". Ну я и набросал код.

[Bee]

Да, я запустил ваш код, по одной удаляются отмеченные строки
А нужно удалить все не отмеченные строки разом, после запуска кода. Решение пока не нашёл.

[Юрий М]

нужно удалить все не отмеченные строки разом

Собираем номера строк, подлежащих удалению, в массив, а потом одним махом удаляем группу этих строк.
 А поочерёдное удаление чем не устраивает? Ведь не тысячи же строк? )

[Bee]

Пару сотен строк может быть.  И эти строки (без галочки!) надо удалить одним махом с листа excel.
Я пробую решить задачу через сортировку и выделение строк на листе excel, но код получается достаточно обьёмный и много действий. Может найдётся более простое решение?

[Юрий М]

В "Хитростях" Дмитрий написал статью про удаление строк по условию. Вариант удаления сразу группы строк, о котором я говорил, можно посмотреть в способе №2.

[Bee]

Выделение строк и удаление из них пустых строк получилось. Не получается из всего диапазона на листе удалить Не выделенные строки.

Код: (vb)

Private Sub ML_CommandButton_Click()

    Dim RowRange As Range
    Dim RowCnt As Integer
    Dim r As Integer
    
    RowCnt = 0
    For r = 0 To ListBox_Ln.ListCount - 1
        If ListBox_Ln.Selected(r) Then
            RowCnt = RowCnt + 1
            If RowCnt = 1 Then
                Set RowRange = ActiveSheet.UsedRange.Rows(r + 1)
                
            Else
                Set RowRange = Union(RowRange, ActiveSheet.UsedRange.Rows(r + 1))
            End If
        End If
    Next r
    
      If Not RowRange Is Nothing Then RowRange.Select
    Unload Me

      LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For ri = LastRow To 1 Step -1
        If Application.CountA(Rows(ri)) = 0 Then Rows(ri).Delete
        
    Next ri

End Sub

[Дмитрий Щербаков(The_Prist)]

Не выделенные строки

Код: (vb)

If ListBox_Ln.Selected(r) =False Then

?

[Юрий М]

А зачем Вы собираете отмеченные строки, если нужно наоборот? И зачем ВЫДЕЛЯЕТЕ отобранные строки?

[Bee]

The_Prist, спасибо большое! Разобрался) Теперь всё работает.

Код: (vb)

Private Sub ML_CommandButton_Click()

    Dim RowRange As Range
    Dim RowCnt As Integer
    Dim r As Integer
    
    RowCnt = 0
    For r = 0 To ListBox_Ln.ListCount - 1
    
        If ListBox_Ln.Selected(r) = False Then
            RowCnt = RowCnt + 1
            If RowCnt = 1 Then
                Set RowRange = ActiveSheet.UsedRange.Rows(r + 1)
            Else
                Set RowRange = Union(RowRange, ActiveSheet.UsedRange.Rows(r + 1))
                
            End If
        End If
      Next r
    RowRange.Delete
    
     Unload Me

End Sub