Как переключить код с Select Range (Input Box) на Row Count? - PullRequest
0 голосов
/ 10 июля 2019

Текущий код указан ниже. Пользователь выбирает Диапазон ячеек, из которых необходимо найти уникальные значения. Вместо этого я знаю диапазон ячеек, который является целым столбцом B базы данных листов. Я попытался переключить код с помощью приведенного ниже кода, но он выдает «Ошибка времени выполнения« 424 »: требуется объект», где я пытаюсь подсчитать количество строк с данными.

Sheets("Database").Activate

last_row = Cells(Row.Count, "B").End(xlUp).Row         <- Error 

Set rngTarget = Sheets("Database").Range("B2:B" & last_row)
If rngTarget Is Nothing Then Exit Sub

Текущий код:

strPrompt = "Select the Range from which you'd like to extract uniques"
    On Error Resume Next
        Set rngTarget = Application.InputBox(strPrompt, "Get Range", Type:=8)
    On Error GoTo 0
    If rngTarget Is Nothing Then Exit Sub

Измененный код: (не работает - выдает ошибку времени выполнения)

Sheets("Database").Activate

last_row = Cells(Row.Count, "B").End(xlUp).Row         <- Error 

Set rngTarget = Sheets("Database").Range("B2:B" & last_row)
If rngTarget Is Nothing Then Exit Sub

Функция rngTarget должна содержать диапазон ячеек, из которых необходимо найти уникальные значения.

Обновление 1 Полный код для справки:

Public Sub WriteUniquesToNewSheet()

    Dim wksUniques As Worksheet
    Dim rngUniques As Range, rngTarget As Range
    Dim strPrompt As String
    Dim varUniques As Variant
    Dim lngIdx As Long
    Dim last_row As Long
    Dim colUniques As Collection
    Set colUniques = New Collection

    'Prompt the user to select a range to unique-ify
    'strPrompt = "Select the Range from which you'd like to extract uniques"
    'On Error Resume Next
    '    Set rngTarget = Application.InputBox(strPrompt, "Get Range", Type:=8)
    'On Error GoTo 0
    'If rngTarget Is Nothing Then Exit Sub '<~ in case the user clicks Cancel

    Sheets("Database").Activate

    last_row = Cells(Row.Count, 2).End(xlUp).Rows

    Set rngTarget = Sheets("Database").Range("B2:B" & last_row)
    If rngTarget Is Nothing Then Exit Sub

    'Collect the uniques using the function we just wrote
    Set colUniques = CollectUniques(rngTarget)

    'Load a Variant array with the uniques
    '(in preparation for writing them to a new sheet)
    ReDim varUniques(colUniques.Count, 1)
    For lngIdx = 1 To colUniques.Count
        varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
    Next lngIdx

    'Create a new worksheet (where we will store our uniques)
    Set wksUniques = Worksheets("Lists")

    Set rngUniques = wksUniques.Range("A2:A" & colUniques.Count + 1)
    rngUniques = varUniques

    'Let the user know we're done!
    MsgBox "Finished!"

End Sub

1 Ответ

1 голос
/ 10 июля 2019

Для начала вы сослались на Row вместо объекта диапазона, представляющего все Rows. Перейдите по ссылкам, чтобы увидеть разницу:)

Далее вы использовали .Activate и поэтому не указали, с какого листа вы работаете. Лучше было бы использовать что-то вроде:

With Thisworkbook.Sheets("Database") 'Can even be dereferenced from worksheets collection
    last_row = .Cells(.Rows.Count, "B").End(xlUp).Row 
    Set rngTarget = .Range("B2:B" & last_row) 'Tricky if last_row is 1
    If rngTarget Is Nothing Then Exit Sub 'Superfluous and can be deleted
End with
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...