VBA поиск значений и удаление из списка (цикл слишком медленный) - PullRequest
Новая
       41

VBA поиск значений и удаление из списка (цикл слишком медленный)

0 голосов
/ 10 декабря 2018

Я получаю документ Excel, отправляемый каждую неделю со списком сотрудников, которые не прошли обучение для новой IT-системы, которую мы получаем.Тем не менее, обучение не относится ко всем, поэтому мне нужно привести в порядок, чтобы получить реальные цифры.

Я составил список сотрудников, для которых обучение не относится (Oprydning), и использую следующий код для поиска по одному имени за раз и удаления из другого списка (Datagrundlag).

Private Sub RydOpKnap_Click()
Dim OprydningAntal As Long
Dim DataAntal As Long
Dim Find As String

Worksheets("Datagrundlag - endelig").Visible = True

OprydningsAntal = Worksheets("Oprydning").UsedRange.Rows.Count
DataAntal = Worksheets("Datagrundlag - endelig").UsedRange.Rows.Count

  Dim r, s As Long
    For r = 2 To OprydningsAntal
        Find = Worksheets("Oprydning").Cells(r, 1).Value
            For s = 2 To DataAntal


                If Worksheets("Datagrundlag - endelig").Cells(s, 3).Value = Find Then
                    Worksheets("Datagrundlag - endelig").Cells(s, 3).EntireRow.Delete
            Exit For
            End If
            Next s
    Next r

    Worksheets("Datagrundlag - endelig").Visible = False

    ActiveWorkbook.RefreshAll

End Sub

Это занимает вечность, так как список нерелевантных сотрудников в настоящее время составляет 460 различных значений (и будет увеличиваться).Есть ли другой способ сделать это?Я совсем новичок в VBA, но можно ли будет использовать массив?Неужели «командная кнопка», которая инициирует код, делает его медленнее?

Заранее спасибо!

Хайди

Ответы [ 2 ]

0 голосов
/ 10 декабря 2018

Есть ли другой способ сделать это?

Да, используйте условное форматирование, чтобы закрасить исключаемые элементы например, , и отфильтруйте, чтобы удалить строки с отформатированнымиячейки.

SO53707228 example

0 голосов
/ 10 декабря 2018

Создайте массив из вашего текущего списка несоответствующих сотрудников и используйте его для автофильтрации с xlFilterValues.Удалить видимые строки и удалить фильтр. 

Option Explicit

Private Sub RydOpKnap_Click()
    Dim i As Long, j As Long

    ReDim notRelevant(0) As Variant

    With Worksheets("Oprydning")
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            ReDim Preserve notRelevant(i-2)
            notRelevant(i - 2) = .Cells(i, "A").Value
        Next i
    End With

    With Worksheets("Datagrundlag - endelig")
        .Visible = True

        If .AutoFilterMode Then .AutoFilterMode = False
        With .Range(.Cells(1, "C"), .Cells(.Rows.Count, "C").End(xlUp))
            .AutoFilter field:=1, Criteria1:=(notRelevant), Operator:=xlFilterValues
            .Offset(1, 0).EntireRow.Delete
        End With
        .AutoFilterMode = False

        .Visible = False
        .Parent.RefreshAll
    End With

End Sub
...