Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Поиск и вывод данных результатов по неточному соответствию с подстановкой значения из другой ячейки
 
#1
10.05.2022 17:10:24
Добрый день!

Подскажите какими функциями можно воспользоваться?
Требуется найти  значения в ячейках A в просматриваемом массиве D2:D5 и в случае совпадения подставить значение ячейки из столбца E.
и
в просматриваемом массиве A2:A5 поиск и просмотр массива D2:D5 на совпадения и вывод значения равно.

P.S Если есть решение скиньте плиз ссылочку.
P.S2 Спасибо заранее.
 
 
 
#2
10.05.2022 18:28:45
Оленька, неточное оно и есть неточное :) Для любой неточности требуются уточнения :) В Вашем случае логичней посмотреть на ввод исходных данных, (т.е. на списки, в т.ч. и зависимые), иначе ВСЕ неточности обнаружить можно только с какой-то не очень большой вероятностью. А насчет функций - текстовые. Либо макрос - перебор по словам или буквам, но это может долго работать. Можно "*" но процент вероятности правильного результата опять же будет зависеть от исходных (списков). Как вариант - сделайте на отдельном листе несколько столбцов (индекс, обл, город, улица - желательно упорядоченно), тогда и решение скорее всего быстрее найдется и работать качественней будет. Еще как вариант - удалить в столбце D все после номеров домов, тогда может и "*" лучше сработает ;)
 
 
 
#3
11.05.2022 11:26:30
Olia_student, здравствуйте!
Можно, например так:

Код
Sub Compare()
Dim arr_, arr_compare, item, temp, lstRow As Long
Dim i, j, find_Val As Integer, what, dcount
With ActiveSheet
    lstRow = .Cells(Rows.Count, 1).End(xlUp).Row
    arr_ = .Range(.Cells(2, 1), .Cells(lstRow, 1))
    lstRow = .Cells(Rows.Count, 5).End(xlUp).Row
    arr_compare = .Range(.Cells(2, 4), .Cells(lstRow, 5))
    For Each i In arr_
        temp = Split(i, ",")
        For j = LBound(arr_compare, 1) To UBound(arr_compare, 1)
            item = Split(arr_compare(j, 1), " ")
            For Each what In item
                find_Val = search_item_in_1d_array(temp, what)
                dcount = dcount + find_Val
            Next what
            If dcount > 4 Then
                .Cells(j + 1, 1).Interior.Color = vbYellow
                .Cells(j + 1, 2) = arr_compare(j, 2)
                .Cells(j + 1, 4).Interior.Color = vbYellow
            End If
            dcount = 0
        Next j
    Next i
End With
End Sub
Function search_item_in_1d_array(arr, what) As Integer
Dim i, item
    For Each i In arr
        If InStr(LCase(i), LCase(what)) Then search_item_in_1d_array = 1: Exit Function
    Next i
search_item_in_1d_array = 0
End Function
Но нужно еще проверить точноть :) . Тестируйте!
 
 
 
#4
16.05.2022 12:52:09
Цитата
написал:
Olia_student , здравствуйте!
Можно, например так:

Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33      Sub   Compare()    Dim   arr_, arr_compare, item, temp, lstRow   As   Long    Dim   i, j, find_Val   As   Integer  , what, dcount    With   ActiveSheet          lstRow = .Cells(Rows.Count, 1).  End  (xlUp).Row          arr_ = .Range(.Cells(2, 1), .Cells(lstRow, 1))          lstRow = .Cells(Rows.Count, 5).  End  (xlUp).Row          arr_compare = .Range(.Cells(2, 4), .Cells(lstRow, 5))          For   Each   i   In   arr_              temp = Split(i,   ","  )              For   j = LBound(arr_compare, 1)   To   UBound(arr_compare, 1)                  item = Split(arr_compare(j, 1),   " "  )                  For   Each   what   In   item                      find_Val = search_item_in_1d_array(temp, what)                      dcount = dcount + find_Val                  Next   what                  If   dcount > 4   Then                      .Cells(j + 1, 1).Interior.Color = vbYellow                      .Cells(j + 1, 2) = arr_compare(j, 2)                      .Cells(j + 1, 4).Interior.Color = vbYellow                  End   If                  dcount = 0              Next   j          Next   i    End   With    End   Sub    Function   search_item_in_1d_array(arr, what)   As   Integer    Dim   i, item          For   Each   i   In   arr              If   InStr(LCase(i), LCase(what))   Then   search_item_in_1d_array = 1:   Exit   Function          Next   i    search_item_in_1d_array = 0    End   Function  
  Но нужно еще проверить точноть  . Тестируйте!
Благодарю.
 
 
 
#5
16.05.2022 13:13:11
Olia_student, к чему такая "цитата"? Поправьте
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх