Страницы: 1
RSS
Поиск первого значения по условию на vba
 
Здравствуйте. Есть таблица с двумя столбцами, 1 - имя, 2 - некоторое значение которое ему соответствует. Мне нужно при повторе имени знать не только новое значение ну и то которое было первым. В столбце C я вручную показал как это должно выглядеть. Подскажите как это можно сделать с помощью макроса?
Изменено: Nazar93 - 03.04.2021 17:08:09
 
Nazar93,
А имя Сиддоров и Сидово это считается повтор или ошибка ввода?
 
Kuzmich,ошибка.. Там будет одинаковое имя
 
Код
Там будет одинаковое имя

Если одинаковых имен только два, то
Код
Sub PoiskName()
Dim Found_Name As Range
Dim FAdr As String
Dim i As Long
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To iLastRow
  Set Found_Name = Columns("A").Find(Cells(i, "A"), , xlValues, xlWhole)
    If Not Found_Name Is Nothing Then
      FAdr = Found_Name.Address
      Do
        Set Found_Name = Columns("A").FindNext(Found_Name)
        Cells(i, "C") = Found_Name.Offset(, 1)
      Loop While Found_Name.Address <> FAdr
    End If
Next
End Sub
 
Kuzmich,Спасибо, работает и для большего количества имен
 
Цитата
работает и для большего количества имен
Тогда в колонке С будет значение для последнего имени
 
Для большего количества имен.Данные должны начинаться с ячейки А1 как в вашем файле
Код
Sub fdsgh()
Dim Rg1 As Range, Rg2 As Range
Set Rg1 = Cells(1).CurrentRegion
    For i = 2 To Rg1.Rows.Count
        Set Rg2 = Rg1.Cells.Find(Cells(i, 1), Cells(i, 1), xlValues, xlWhole, 2)
        If Not Rg2 Is Nothing And Rg2.Row > i Then Rg2.Offset(, 2) = Cells(i, 2)
    Next
End Sub
Изменено: Евгений Смирнов - 03.04.2021 18:34:36
 
Доброе время суток.
Kuzmich, а почему не на словаре? На пятистах фамилиях 2,6 секунды поиском против 0,008 на словаре.
Код
Public Sub InsertFirstEntry()
    Dim lRow As Long, vData As Variant, sKey As String
    Dim i As Long, pDict As Object, vOut() As Variant, t As Single
    t = Timer
    lRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    vData = ActiveSheet.Range(ActiveSheet.Cells(2, 1), ActiveSheet.Cells(lRow, 2)).Value
    ReDim vOut(1 To UBound(vData), 1 To 1)
    Set pDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(vData)
        sKey = vData(i, 1)
        If Not pDict.Exists(sKey) Then
            pDict(sKey) = vData(i, 2)
        End If
        vOut(i, 1) = pDict(sKey)
    Next
    ActiveSheet.Range("C2").Resize(UBound(vOut), 1).Value = vOut
    Debug.Print Timer - t
End Sub
 
=IFERROR(VLOOKUP(A2;A$1:B1;2;);"") или я чего то не понял?

upd. а не понял я что нужно на VBA  :D
Изменено: БМВ - 03.04.2021 19:17:14
По вопросам из тем форума, личку не читаю.
 
Евгений Смирнов, Андрей VG,Спасибо большое
 
Медведя обделили ((
 
Цитата
Юрий М написал:
Медведя обделили ((
так он не макрушник  :D
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх