Удалить строки на основе значения ячейки не работает - PullRequest
0 голосов
/ 16 января 2019

У меня есть некоторые данные на листе под названием New, и мои данные находятся в столбцах от A до столбца K. Однако столбцы с E по H намеренно оставлены пустыми для целей анализа данных, и у меня нет заголовка, поэтому мои данные начинаются с ячейки A1.Теперь в столбце A у нас есть цвет в ячейке, я хотел бы удалить все строки, которые не являются белыми, поэтому оставьте строки, в которых нет цвета.

Я провел небольшое исследование, но все коды яВыйти в Интернет или удалить весь лист или просто пройти через коды, и ничего не происходит.Ниже приведены те, которые я сейчас использую, которые ничего не делают.Я использую F8 и все еще без ошибок.

См. Изображение для моих образцов данных, и я пытаюсь получить результаты с ячейками, которые не имеют какого-либо цвета в нем.Я пытался удалить кавычку для индекса цвета, но все равно он не работает.

 Sub deleterow()

 lastRow = Worksheets("New").Cells(Rows.Count, "A").End(xlUp).Row
 For i = lastRow To 1 Step -1
      If Worksheets("New").Cells(i, 1).Interior.ColorIndex <> "2" Then
           Rows(i).EntireRow.Delete
           i = i + 1
      End If
 Next I

 End Sub

enter image description here enter image description here

Ответы [ 2 ]

0 голосов
/ 16 января 2019

Удалить без цветного ряда

Версия Union

Option Explicit

Sub DeleteNoColorRow()

    Const cSheet As Variant = "Sheet1"  ' Worksheet Name/Index
    Const cFirstR As Integer = 1        ' First Row
    Const cColumn As Variant = "A"      ' Column Letter/Number

    Dim rngU As Range     ' Union Range
    Dim lastRow As Long   ' Last Row
    Dim i As Long         ' Row Counter

    With ThisWorkbook.Worksheets(cSheet)
        lastRow = .Cells(.Rows.Count, cColumn).End(xlUp).Row
        For i = cFirstR To lastRow
            If .Cells(i, cColumn).Interior.ColorIndex <> xlNone Then
                If Not rngU Is Nothing Then
                    Set rngU = Union(rngU, .Cells(i, cColumn))
                  Else
                    Set rngU = .Cells(i, cColumn)
                End If
            End If
        Next
    End With

    If Not rngU Is Nothing Then
        rngU.EntireRow.Delete ' Hidden = True
        Set rngU = Nothing
    End If

End Sub
0 голосов
/ 16 января 2019

Попробуйте код ниже:

Option Explicit

Sub deleterow()

Dim i As Long, LastRow As Long

With Worksheets("New")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For i = LastRow To 1 Step -1
        'If .Cells(i, 1).Interior.Color <> xlNone Then
        ' replace RGB(255, 255, 255) with the "white" color
        If .Cells(i, 1).Interior.Color <> RGB(255, 255, 255) Then
            .Rows(i).Delete
        End If
    Next i
End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...