Использование «подстановочных знаков» в массиве vlist для удаления строк в Excel - PullRequest
Новая
       22

Использование «подстановочных знаков» в массиве vlist для удаления строк в Excel

0 голосов
/ 11 мая 2010

Я пытаюсь настроить макрос vba для удаления всех идентификаторов пользователей из электронной таблицы, которые не начинаются с назначенных префиксов (например, US, A1, VM и т. Д.). Приведенный ниже блок кода был найден в библиотеке кодов и выглядит как то, что мне нужно, но есть одна проблема: когда я ввожу префиксы UserID в поля vlist, он обрабатывает их как абсолютные, а не как часть нужной мне строки сохранить.

Есть ли способ включить подстановочные знаки в список vlist? 

Sub Example1()
    Dim vList
    Dim lLastRow As Long, lCounter As Long
    Dim rngToCheck As Range, rngFound As Range, rngToDelete As Range

    Application.ScreenUpdating = False

    With Sheet1
        lLastRow = Get_Last_Row(.Cells)

        If lLastRow > 1 Then

            vList = Array("US", "A1", "EG", "VM")

            'we don't want to delete our header row
            With .Range("A2:A" & lLastRow)

                For lCounter = LBound(vList) To UBound(vList)

                    Set rngFound = .Find( _
                                        what:=vList(lCounter), _
                                        lookat:=xlWhole, _
                                        searchorder:=xlByRows, _
                                        searchdirection:=xlNext, _
                                        MatchCase:=True)

                    'check if we found a value we want to keep
                    If rngFound Is Nothing Then

                        'there are no cells to keep with this value
                        If rngToDelete Is Nothing Then Set rngToDelete = .Cells

                    Else

                        'if there are no cells with a different value then
                        'we will get an error
                        On Error Resume Next
                        If rngToDelete Is Nothing Then
                            Set rngToDelete = .ColumnDifferences(Comparison:=rngFound)

                        Else
                            Set rngToDelete = Intersect(rngToDelete, .ColumnDifferences(Comparison:=rngFound))
                        End If
                        On Error GoTo 0

                    End If

                Next lCounter
            End With

            If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

        End If
    End With

    Application.ScreenUpdating = True
End Sub

1 Ответ

0 голосов
/ 11 мая 2010

Интересно - я никогда раньше не замечал метод ColumnDifferences, так что спасибо за это.

Будучи незнакомым с этим, я не мог понять, что вы пытались сделать с этим макросом.

Если вы проверяете содержимое столбца A, чтобы увидеть, соответствуют ли первые два символа в каждой ячейке значениям в вашем массиве, и если он удаляет всю строку, вы можете сделать это с помощью цикла следующим образом: 

Sub Example2()

    Dim lLastRow As Long
    Dim lCounter As Long

    Application.ScreenUpdating = False

    With Sheet1

        lLastRow = Get_Last_Row(.Cells)

        If lLastRow > 1 Then

            For lCounter = lLastRow To 2 Step -1

                Select Case Left(.Cells(lCounter, 1).Value, 2)
                    Case "US", "A1", "EG", "VM"
                        .Cells(lCounter, 1).EntireRow.Delete
                End Select

            Next lCounter

        End If

    End With

    Application.ScreenUpdating = True

End Sub

Обратите внимание, что когда вы просматриваете и удаляете строки, вам нужно начинать с последней строки и двигаться вверх.

Если это не совсем то, что вы пытаетесь сделать, дайте мне знать, и я попробую еще раз:)

...