Уважаемые коллеги, проблему решил неожиданно просто. Слепил из двух макросов (вышеприведенного допиленного урезанного и макроса, перебирающего файлы Word в папке).
Скрытый текст
Sub parswordtab()
Set WordObj = CreateObject("Word.Application") MyPath = "C:\из\" 'указать путь к папке iFileName = Dir(MyPath) 'имя первого файла в папке. Не менять!!! Do While iFileName <> "" Set WordDoc = WordObj.Documents.Open(MyPath + iFileName) 'открываем первый файл WordObj.Visible = False 'можно его отображать, можно не отображать
'Здесь должен быть код по обработке файлов
'Для написания макроса, удобно подключить библиотеку для работы 'с программой "Word". Затем можно будет отключить эту библиотеку: 'Tools - References... - Microsoft Word версия Object Library.
'Копирование первой таблицы в Word-файле. 'Range - это фрагмент Word-файла, где находится таблица. WordDoc.Tables(1).Range.Copy
Worksheets.Add.Name = iFileName
'Выделение ячейки, куда будут вставлены данные. 'Для вставки в Excel будет использоваться метод "PasteSpecial", 'который относится к объекту "Worksheet". Метод "PasteSpectial" 'ещё есть у объекта "Range". У объекта "Worksheet" нельзя 'указать ячейку, куда надо вставить, поэтому нужно заранее 'выделить нужную ячейку, куда будут вставлены данные. ActiveSheet.Range("A1").Select
'Вставка скопированной таблицы в активный Excel-лист в выделенную ячейку. 'Код записал с помощью макрорекордера, делая такие действия в "Excel 2010": 'вкладка "Главная" - группа "Буфер обмена" - "Вставить (со стрелкой)" - '"Специальная вставка..." - кружок "Вставить" - "HTML". ActiveSheet.PasteSpecial Format:="HTML", Link:=False
'Чтобы в буфере обмена не было много данных, очищаем буфер обмена, 'копируя в него только одну ячейку. WordDoc.Tables(1).cell(1, 1).Range.Copy
'Конец кода по обработке файлов
WordObj.Documents(iFileName).Close SaveChanges:=False 'сохраняем/не сохраняем и закрываем файл iFileName = Dir 'получение следующего имени файла в папке. Не менять!!! Loop WordObj.Quit 'закрываем MS WORD Set WordDoc = Nothing 'освобождаем память Set WordObj = Nothing 'освобождаем память MsgBox "Файлы обработаны!", vbOKOnly + vbInformation, "Обработка файлов" End Sub
Есть папка со множеством документов Word, документы сделаны (должны быть сделаны) по шаблону. В каждом документе есть таблица, ее надо выдернуть в Excel (безразлично, в одну книгу в разные листы или в разные книги, или даже в один лист); кроме того, надо добавить идентификатор, соответствующий файлу, чтобы понять, к чему относится выдернутая таблица (идентификатор - можно название файла, можно из текста документа №50Т00666.
Скрытый текст
В принципе, если я посижу достаточно долго над написанием и отладкой, я победю эту задачу. Я уже понасочинял и понасобирал из исходников кучу макросов для подобных задач. Но, к сожалению, тут не успеваю. Прошу помочь.
В принципе, я нашел даже почти готовый макрос,
Скрытый текст
Sub Procedure_1()
'В константе "strDocFullName" нужно указать полное имя Word-документа, 'из которого нужно скопировать таблицу. Const strDocFullName As String = "C:\Users\User\Desktop\Из.docx"
'Для написания макроса, удобно подключить библиотеку для работы 'с программой "Word". Затем можно будет отключить эту библиотеку: 'Tools - References... - Microsoft Word версия Object Library. Dim myWord As Word.Application Dim docSource As Word.Document
'Запуск и VBA-наименование программы "Word". 'Даём программе "Word" VBA-имя "myWord" и через 'это имя будем работать с программой Word в макросе. Set myWord = CreateObject(Class:="Word.Application")
'Делаем программу Word видимой, чтобы было удобно писать код. myWord.Visible = True
'Открытие и VBA-наименование Word-файла. Set docSource = myWord.Documents.Open(Filename:=strDocFullName)
'Копирование первой таблицы в Word-файле. 'Range - это фрагмент Word-файла, где находится таблица. docSource.Tables(1).Range.Copy
'Выделение ячейки, куда будут вставлены данные. 'Для вставки в Excel будет использоваться метод "PasteSpecial", 'который относится к объекту "Worksheet". Метод "PasteSpectial" 'ещё есть у объекта "Range". У объекта "Worksheet" нельзя 'указать ячейку, куда надо вставить, поэтому нужно заранее 'выделить нужную ячейку, куда будут вставлены данные. ActiveSheet.Range("A1").Select
'Вставка скопированной таблицы в активный Excel-лист в выделенную ячейку. 'Код записал с помощью макрорекордера, делая такие действия в "Excel 2010": 'вкладка "Главная" - группа "Буфер обмена" - "Вставить (со стрелкой)" - '"Специальная вставка..." - кружок "Вставить" - "HTML". ActiveSheet.PasteSpecial Format:="HTML", Link:=False
'Чтобы в буфере обмена не было много данных, очищаем буфер обмена, 'копируя в него только одну ячейку. docSource.Tables(1).Cell(1, 1).Range.Copy
'Закрытие Word-документа. '0 - без сохранения. docSource.Close SaveChanges:=0
'Закрытие программы "Word". myWord.Quit SaveChanges:=0
End Sub
и даже шикарно описанный, но у меня уже мозг устал, а его надо обвязать необходимыми бантиками (перебор файлов в указанной папке, создание целевого файла, куда копировать данные, и т.п.)
Помогите дописать, пожалуйста! (А может, у кого-то есть что-то готовое?)
Сравниваю две больших таблицы адресов (в одной 40 с лишним тысяч строк, в другой 25 тыс.) В первой адреса по несколько раз встречаются, с разными данными в других столбцах, во второй уникальны.
Когда напускаю VLOOKUP2 на весь первый список (только по первому вхождению, не по всем) - обработка занимает более получаса. Проц i7-4770, памяти 8 гигов. Смотрю загрузку ядер - четыре ядра загружены на примерно 30% каждое, еще 4 (видимо, которые гипертрейдинг) вообще на нуле.
Если искать все вхождения (а их там до пяти может быть) - это несколько часов (даже с оптимизацией, чтобы не искать следующее, если предыдущего не было.)
Внутрь VLOOKUP2 не смотрел пока, но подозреваю, что получается столько циклов в цикле в цикле, что ойойой...
Вот сижу и думаю - лучше бы я посидел полчасика и сочинил свою длинную лапшеформулу, которая за пару минут бы все мне сделала, чем ждать когда это всё отработает. Ну, ладно, может приспособлюсь.
vikttur написал: Выделить Вашу формулу в строке формул, нажать F9
Шаманство, однако... Но если нажать кноповку отладки (которая "Вычислить формулу"), то там для моей формулки такого не получается. А для Вашей - чудесным образом получается.
Круто! Искать в массиве ошибок число - здорово придумано. Спасибо!
А можно вопрос - почему не работало очевидное простое решение, которое я пытался применить? Смотрел через отладку - оно не преобразует в массив. Почему же в Вашем варианте НАЙТИ преобразует, а в моем - нет?
Подскажите, пожалуйста, как найти в строке, содержащей несколько слов, любое слово из диапазона.
Первое, что пришло в голову: {=НАЙТИ(диапазон;строка)} Если в диапазоне в первой ячейке есть слово, содержащееся в строке, то "найти" его находит. Если слово содержится в диапазоне не в первой ячейке, "найти" его не находит, выдает ошибку.
Думал над вариантом с ЧАСТОТА, но что-то тоже не родилось ничего толкового. Поиск в гугле и внутре Планеты выдает, как правило, "как найти совпадение ячеек с ячейкой из диапазона". Можно, конечно, распарсить строку и сравнивать с диапазоном каждое слово, но как-то некрасиво, грубо и не будет работать для строк с большим количеством слов внутре...
Помогите, пожалуйста! Прилагаю пример. Фрагмент реальных данных в первой колонке, диапазон в третьей, и во второй колонке моя попытка сделать сравнение. Микрософт Офис профессиональный плюс 2013 64-битный. Легальный, на работе.