Страницы: 1
RSS
VBA: найти последнее искомое значение
 
Добрый день уважаемые знатоки. Опять обращяюсь к Вам, так как знание не хватает у меня. Сам посторался, но не смог вытащить желаемого результата.
Задача: Найти самую последнюю искоемое значение и копировать в другую ячейку. Вот код:
Код
Sub Poisk()
Dim lamp As Range, Table As Range
With [a:a]
    Set lamp = .Find("Lamp", , xlValues, xlWhole)
    If lamp Is Nothing Then Exit Sub
    Set lamp = .FindNext(lamp)
    lamp.Offset(0, 1).Copy [c2]
        
    Set Table = .Find("Table", , xlValues, xlWhole)
    If Table Is Nothing Then Exit Sub
    Set Table = .FindNext(Table)
    Table.Offset(0, 1).Copy [c3]
    End With
End Sub

Но он не находит самую последнюю искоемое значение. Где в коде я должен изменить, что бы получить желаемый результат. Спасибо.
 
Почитайте в справке по Excel как используется .FindNext
Согласие есть продукт при полном непротивлении сторон
 
abduvs77, Последняя это не та, которая после предпоследней, а та, которая перед первой  на втором круге.
По вопросам из тем форума, личку не читаю.
 
если правильно назвать функцию  - она будет выдавать правильные результаты
Код
Function FindLast(FindWhat, FindWhere As Range)
  Set FindLast = FindWhere.Find(FindWhat, , xlValues, xlWhole, SearchDirection:=xlPrevious, SearchFormat:=False)
End Function

Sub Poisk()
  Dim rg As Range
  Set rg = FindLast("Lamp", [a:a]):   If Not rg Is Nothing Then [c2] = rg.Offset(0, 1)
  Set rg = FindLast("Table", [a:a]):  If Not rg Is Nothing Then [c3] = rg.Offset(0, 1)
End Sub
названа ИскатьПоследний - находит последний
Изменено: Ігор Гончаренко - 11.03.2018 15:06:35
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко,  Спасибо, то что нужно.
Возник вопрос: А нельзя ли изменить мой код что бы она работала? И без Function никак нельзя?
 
abduvs77, ищите только лампы и столы? Последняя строка с найденным или количество найденных значений?

Последняя строка по всем уникальным значениям столбца "А":
Код
Sub FindLast()
Dim dict As Object, aa As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each aa In Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1))
  If Not dict.exists(aa.Value) Then
    dict.Add aa.Value, aa.Row
  Else
    dict.Item(aa.Value) = aa.Row
  End If
Next
[D1].Resize(dict.Count) = Application.Transpose(dict.keys)
[E1].Resize(dict.Count) = Application.Transpose(dict.items)
End Sub
Кол-во повторений каждого значения:
Код
Sub FindCopies()
Dim dict As Object, aa As Range
Set dict = CreateObject("Scripting.Dictionary")
For Each aa In Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1))
  If Not dict.exists(aa.Value) Then
    dict.Add aa.Value, 1
  Else
    dict.Item(aa.Value) = dict.Item(aa.Value)+1
  End If
Next
[D1].Resize(dict.Count) = Application.Transpose(dict.keys)
[E1].Resize(dict.Count) = Application.Transpose(dict.items)
End Sub
Изменено: Anchoret - 11.03.2018 15:11:03
 
Anchoret, да, только ламп и столы. Нужна последняя строка с найденным.
 
Sanja, БМВ, Ігор Гончаренко, Anchoret,  спасибо Вам. Задача решена с помощью Ігор Гончаренко,
Страницы: 1
Наверх