Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Главное меню

Макрос поиска в строке по заданному шаблону (маске)

Автор Energo, 21.02.2012, 20:30

« назад - далее »

Energo

Нужен макрос (функции не подойдут) для поиска в строковой переменной, читаемой из файла, (она порядка 1098834 символов) по задаваемому шаблону. Для начала подскажите как определить позицию вхождения заданного шаблона в эту длинную строку?
ЗЫ Строка в ячеку не влазиет - уже проверял.

kuklp

Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771

Energo

Спасибо.
Нашел решение - вместо чтения строки из файла целиком использую макрос чтения из файла построчно. Далее каждую строчку анализирую на предмет нужного шаблона.

Dim XmlFileName As String   'имя текущего xml
Dim DataPath As String      'путь к папке с xml
Dim i As Integer
Dim day As String

    Cells(1, 10).Select  ' тут пишется кусок прочтенной строки из xml
    Cells(1, 10).Clear    'очистка ячейки перед началом работы
   





'задаем имя текущего xml файла ЦИКЛ
For i = 1 To 20 'число дней для отчета************************************************************

'имя файла в формате 01.xml ,02,03,04,05,06,07,08,09,10,11,12...
If i < 9 Then XmlFileName = "0" & i & ".xml"
If i > 9 Then XmlFileName = i & ".xml"



'путь к текущей папке, далее к папке "xml"
If [DataPath] = "" Then Path = ActiveWorkbook.Path & "\" & "xml\" Else If Right([DataPath], 1) = "\" Then Path = [DataPath] Else Path = [DataPath] & "\"

'Open (Path & XmlFileName) For Input As #1 'открываем файл xml из подпапки "xml" для чтения построчно

Open (Path & XmlFileName) For Input As #1 'открываем файл xml из подпапки "xml" для чтения построчно



Application.DisplayStatusBar = True
Application.StatusBar = "Обработка " & XmlFileName

    Do Until EOF(1)                 'цикл чтения до конца файла
    Line Input #1, Data             'читаем одну строку
    Cells(1, 10) = Data             'пишем прочтенную строку в ячейку (1,10) для анализа кода
    DataLong = Len(XmlData)         'длина строки кода в символах
    '-----------------------------------------------------------
        'ловим <day>*</day>
        If Cells(1, 10) Like "*<day>*</day>" Then
          '  MsgBox "<day>*</day> найден" 'нашли <day>*</day>
           
            iData = LTrim(Data) 'Функция LTrim удаляет пробелы в начале строки
            iData = RTrim(iData) 'Функция RTrim удаляет пробелы в конце строки

         
            tag_long = Len(iData) 'длина строки тэга без пробелов
            Cells(7, 10) = tag_long 'отладочная переменная
           
            start_tag_long = 5                          '5 - длина тэга <day>
            end_tag_long = 6                            '6 - длина тэга </day>
            cut_size = tag_long - start_tag_long - end_tag_long    'число вырезаемых символов данных
           
                                                               
            day = Mid(iData, start_tag_long + 1, cut_size) 'данные из тэга
           
            Cells(8, 11) = Right(day, 2) 'номер суток -> В ТАБЛИЦУ !!!!
           
            Cells(8, 10) = day 'отладочная переменная
           
            '********<day>*</day> найден и записан в Cells(8, 10)**************
            'Close #1
            'Exit Sub'отладочный выход
         
        End If
   
   
    '-----------------------------------------------------------
    Loop                            'читаем следущую строку xml
    Close #1                         'закрываем файл xml

    Application.StatusBar = "Файл " & XmlFileName & " прочтен полностью"
   
Next i  '**************************************************************************************************************


'ВЫХОД

Application.StatusBar = "Обработка всех файлов завершена!"
Application.StatusBar = False
Application.DisplayStatusBar = saveStatusBar

End Sub