Range.AdvancedFilter, дающий противоречивые результаты - PullRequest
0 голосов
/ 10 июля 2019

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

Хотя я использую одни и те же данные, число создаваемых элементов будет варьироваться между 263(неверно) и 268 (правильно).

Эти уникальные записи извлекаются из основного списка, содержащего 7667 записей (с дубликатами).

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

Он вернул оба этих результата, независимо от каких-либо изменений, внесенных в сценарий.Я не разобрался, как повторить эту ошибку.

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

Sub Test()
    Dim aArray() As Variant
    Dim cell As Range
    Dim aRange As Range
    Dim i As Integer

    Worksheets.Add After:=Sheets(1)
    ActiveSheet.Name = "Temporary_1"
    Sheets(1).Activate
    Sheets(1).Range(Range("D1"), Range("D1").End(xlDown)).AdvancedFilter 
    Action:=xlFilterCopy, CopyToRange:=Sheets(2).Range("A1"), Unique:=True
    Sheets(2).Activate

    Set aRange = Sheets(2).Range(Range("A2"), Range("A2").End(xlDown))
    Debug.Print aRange.Count
    ReDim aArray(aRange.Count - 1)
    For Each cell In aRange.Cells
        aArray(x) = cell.Value
        x = x + 1
    Next cell

    i = 0
    For x = LBound(aArray) To UBound(aArray)
        i = i + 1
    Next x
    Debug.Print i

End Sub

Есть ли более надежный способ создания массива из уникальных записей в столбце?

1 Ответ

0 голосов
/ 10 июля 2019

Вы использовали .End(xlDown), хотя мы не знаем, есть ли в ваших данных пробелы.

Вы пытались изменить

Sheets(1).Range(Range("D1"), Range("D1").End(xlDown)).AdvancedFilter

, чтобы прочитать:

With Sheets(1)
    lr = .Cells(.Rows.Count, 4).End(xlUp).Row
    .Range(.Range("D1"), .Range("D" & lr)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2).Range("A1"), Unique:=True
End With

Обратите внимание, что я также добавил ссылки на листы к другому диапазону, поскольку это соответствующим образом квалифицировало бы диапазон (первые листы (1) НЕ переносятся или предполагаются VBA).

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