Страницы: 1
RSS
Заполнение диапазона ячеек по данным из двух других диапазонов
 
Добрый день.

В очередной раз прошу помощи в написании макроса.

На листе есть три таблицы.
В Таблице 1 есть какие то данные которые обязательно содержат уникальное число.
В первом столбце Таблице 2 идет список этих уникальных значений, во втором столбце название города соответствующее каждому значению.
Необходимо заполнить Таблицу 3 в порядке соответствующем Таблице 1.

Прикрепил файл для более наглядного примера.

Заранее спасибо.
 
Понимаю что макрос не сложный, но сообразить не могу. Опыта маловато...
 
А в первой таблице числа от текста не отделены пробелом?
 
Юрий М, нет, они могут быть в любом месте текста.
 
Как вариант.
Данный код необходимо поместить в стандартный модуль книги. После этого в мастере функций в категории Определенные пользователем (User Defined) будет доступна функция Extract_Number_from_Text, которую можно будет применять как обычную функцию на листе.
Для извлечения только чисел =Extract_Number_from_Text(A1; 0). Вытаскиваем чисел, копируем и вставим значение, переобразуем в число. Потом пользуемся обычным ВПРом.
PS. Код с этого форума.
Код
Function Extract_Number_from_Text(sWord As String, Optional Metod As Integer)
    Dim sSymbol As String, sInsertWord As String
    Dim i As Integer
 
    If sWord = "" Then Extract_Number_from_Text = "Нет данных!": Exit Function
    sInsertWord = ""
    sSymbol = ""
    For i = 1 To Len(sWord)
        sSymbol = Mid(sWord, i, 1)
        If Metod = 1 Then
            If Not LCase(sSymbol) Like "*[0-9]*" Then
                If (sSymbol = "," Or sSymbol = "." Or sSymbol = " ") And i > 1 Then
                    If Mid(sWord, i - 1, 1) Like "*[0-9]*" And Mid(sWord, i + 1, 1) Like "*[0-9]*" Then
                        sSymbol = ""
                    End If
                End If
                sInsertWord = sInsertWord & sSymbol
            End If
        Else
            If LCase(sSymbol) Like "*[0-9.,;:-]*" Then
                If LCase(sSymbol) Like "*[.,]*" And i > 1 Then
                    If Not Mid(sWord, i - 1, 1) Like "*[0-9]*" Or Not Mid(sWord, i + 1, 1) Like "*[0-9]*" Then
                        sSymbol = ""
                    End If
                End If
                sInsertWord = sInsertWord & sSymbol
            End If
        End If
    Next i
    Extract_Number_from_Text = sInsertWord
End Function
Изменено: abduvs77 - 13.04.2018 00:06:02 (Изменён прикреплённый файл)
 
См. вариант
 
Юрий М, спасибо большое, то что надо.
abduvs77, тоже спасибо за помощь.
Страницы: 1
Наверх