Выборка данных содержащихся в строках - VBA

Узнай цену своей работы

Формулировка задачи:

Добрый день. Есть следующая задача. Есть большая обновляемая таблица более 8000 записей с более 70 столбцов. В одном из столбцов содержатся пункты следующего вида "2.2.1.4.5", "2.1.17", "1.5", "2", "2.3.7.2, 2.2.7.2" и т.п. поле может быть и пустым. Есть вторая необновляемая таблица в которой содержатся все вероятные пункты (они в ней отсортированы и не повторяются) и во втором столбце их описание. Обе таблицы доступны по сети. Задача ежедневно забирать себе данные по ключам второй таблицы из первой таблицы и проверять обновление. В идеале каждый день забирать только измененные данные.

Собственно с чем прошу помочь.

При выполнении возникла проблема с сравнением строк: У меня не получается сделать правильную выборку. Первая таблица: __Вторая: ___Забираем ли строку: 2.3.7.2, 2.2.7.3 ___2.2 ________Нет _____________ ___2.2.7 ______Нет _____________ ___2.2.7.2 _____Да _____________ ___2.3.7.2 _____Да _____________ ___2.7 ________Нет _____________ ___2.6 ________Нет _____________ ___22.2.7.2 ____Нет _____________ ___2 __________Нет В более формальном виде

перед искомым выражением

не должно быть

цифр, точек, запятых, букв

могут быть

пробел, либо вообще не быть символов.

после искомого выражения

не должно быть

цифр, точек, букв

могут быть

запятая, точка с запятой, открывающая скобка, пробел, может не быть символа вообще. Сколько не пробовал с конструкциями вида If ("*[!.,#]" & Text2 & "[!.#]" ) Like Text Then Flag = 1 Else: Flag = 0 и т.п. ничего не получилось. (Буквы сейчас не встречаются, но на будущее хотелось бы заглушку) Прошу Вашей помощи либо с решением данной проблемы, либо с советом куда копать. Всем заранее спасибо за ответы. P.S. Если кто сталкивался с подобными задачами с удовольствием выслушаю советы и буду благодарен за ссылки на решение подобных задач.

Решение задачи: «Выборка данных содержащихся в строках»

textual
Листинг программы
Sub Проставить_номера_строк_по_кодам()
    Dim i&, j&, k%, LastRow1&, LastRow2&, A, B, C, Arg, Dic As Object
    Const FirstRow = 3
    Const MyDelimiter$ = "; " 'для разделения вывода нескольких найденный статей
    Set Dic = CreateObject("Scripting.Dictionary") ' Создаем словарь из отсортированого содержимого
    Dic.CompareMode = 1
    With Лист2 '  таблица в которой содержатся все вероятные пункты (они в ней отсортированы и не повторяются) и во втором столбце их описание.
        LastRow1 = .UsedRange.Rows.Count - .UsedRange.Row + 1
        A = .Range(.Cells(1, 1), .Cells(LastRow1, 2)).Value
        For i = 1 To LastRow1
            Dic(A(i, 1)) = i ' ст. 1 код, ст.2 номер строки на листе 1
        Next i
    End With
    With Лист3 ' Рабочая таблица
        .Range("A1").Resize(UBound(A, 1), UBound(A, 2)).Value = A
    End With
    With Лист1 ' Анализируема таблица
        LastRow2 = .UsedRange.Rows.Count - .UsedRange.Row + 1
        A = .Range(.Cells(1, 9), .Cells(LastRow2, 9)).Value
    End With
    With Лист3 ' Рабочая таблица, столбцы 3-12 номера найденных строк с кодами в 9-том столбце листа 1
        .Range(.Cells(1, 3), .Cells(LastRow1, 112)).ClearContents 'Очищаем от предыдущих результатов
        C = .Range(.Cells(1, 1), .Cells(LastRow1, 112)).Value
        For i = 1 To UBound(A)
            'A(i, 2) = Empty ' Столбец вывода результатов 2
            If A(i, 1) <> "" Then ' Столбец искомых кодов 1
                Arg = Trim$(A(i, 1))
                'Все нестандартные разделители кода заменяем на стандартные
                Arg = Replace$(Arg, " ", ";")
                Arg = Replace$(Arg, ",", ";")
                Arg = Replace$(Arg, "(", ";")
                B = Split(Arg, ";") ' Получаем массив кодов
                For j = 0 To UBound(B)
                  If B(j) <> "" Then
                    If Dic.Exists(B(j)) Then ' Если код статьи есть в словаре
                        For k = 1 To 110
                            If C(Dic.Item(B(j)), 2 + k) = Empty Then
                                C(Dic.Item(B(j)), 2 + k) = i
                                Exit For
                            End If
                        Next k
                    End If
                  End If
                Next j
            End If
        Next i
        .Range(.Cells(1, 1), .Cells(LastRow1, 112)).Value = C
    End With
    Set Dic = Nothing
End Sub

Оцени полезность:

7   голосов , оценка 3.571 из 5
Похожие ответы