Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сопоставление ячеек с частично совпадающей информацией - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сопоставление ячеек с частично совпадающей информацией (Макросы/Sub)
Сопоставление ячеек с частично совпадающей информацией
tganeev Дата: Вторник, 22.09.2020, 18:21 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Коллеги,
есть ли у кого мысли, как можно решить задачу описанную в приложенном файле средствами VBA?
К сообщению приложен файл: Task.xlsx(9.8 Kb)


Сообщение отредактировал tganeev - Вторник, 22.09.2020, 18:23
 
Ответить
СообщениеКоллеги,
есть ли у кого мысли, как можно решить задачу описанную в приложенном файле средствами VBA?

Автор - tganeev
Дата добавления - 22.09.2020 в 18:21
Hugo Дата: Вторник, 22.09.2020, 18:50 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3089
Репутация: 665 ±
Замечаний: 0% ±

Ответил на планете.
К сообщению приложен файл: 7909915.xlsx(10.6 Kb)


excel@nxt.ru
webmoney: E265281470651 R418926282008 Z422237915069
 
Ответить
СообщениеОтветил на планете.

Автор - Hugo
Дата добавления - 22.09.2020 в 18:50
Michael_S Дата: Вторник, 22.09.2020, 18:50 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 2005
Репутация: 372 ±
Замечаний: 0% ±

Excel2016
[vba]
Код
Sub Find_Telefon()
    Dim Tel As Object, Arr(), i&, Cel As Range, a
    Set Tel = CreateObject("Scripting.Dictionary")
    Arr = Range("D4:E17")
    For i = 1 To UBound(Arr)
        Tel(Arr(i, 1) & "") = Arr(i, 2)
    Next
    For Each Cel In Range("A4", Cells(Rows.Count, 1).End(xlUp))
        a = Split(Cel.Value, ",")
        For i = 0 To UBound(a)
            If Tel.exists(Trim(a(i))) Then
                Cel.Offset(0, 1) = Tel(Trim(a(i)))
                Exit For
            End If
        Next
    Next
End Sub
[/vba]
К сообщению приложен файл: Task_1.xlsm(18.9 Kb)
 
Ответить
Сообщение[vba]
Код
Sub Find_Telefon()
    Dim Tel As Object, Arr(), i&, Cel As Range, a
    Set Tel = CreateObject("Scripting.Dictionary")
    Arr = Range("D4:E17")
    For i = 1 To UBound(Arr)
        Tel(Arr(i, 1) & "") = Arr(i, 2)
    Next
    For Each Cel In Range("A4", Cells(Rows.Count, 1).End(xlUp))
        a = Split(Cel.Value, ",")
        For i = 0 To UBound(a)
            If Tel.exists(Trim(a(i))) Then
                Cel.Offset(0, 1) = Tel(Trim(a(i)))
                Exit For
            End If
        Next
    Next
End Sub
[/vba]

Автор - Michael_S
Дата добавления - 22.09.2020 в 18:50
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сопоставление ячеек с частично совпадающей информацией (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2020 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!