Текущий код указан ниже. Пользователь выбирает Диапазон ячеек, из которых необходимо найти уникальные значения. Вместо этого я знаю диапазон ячеек, который является целым столбцом 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