Вопрос:

Макрос для копирования данных из Word в Excel на основе заголовков и окружающего текста

excel vba excel-vba ms-word

1903 просмотра

2 ответа

1 Репутация автора

Я полностью новичок в VBA и создании макросов, поэтому я хотел бы попросить о помощи. По сути, мне дают файл MS Word, который содержит 30 дел каждую неделю, в которых я должен получить некоторые данные и поместить их в столбцы в Excel. Я хочу автоматизировать эту задачу.

В основном файл MS Word выглядит так:

https://imgur.com/a/0msJs

Копирование этих предметов занимает у меня много времени.

Я думаю о 2 подходах:

  1. Добавьте теги к заголовкам и цитатам, поскольку у них нет ни одного заголовка или чего-либо, что могло бы их отличить: / title A против B и / cite 123 ABC 234 (желтая и фиолетовая подсветка на рисунке) И поручите макросу взять абзац после / title и / cite.

  2. Поручите макросу искать весь абзац после « ОБЗОР: », поскольку эти данные различаются по этой строке.

Резюме: я хочу, чтобы макрос выполнялся в MS Word, скопировал все заголовки дел (желтый) в столбец существующего листа Excel, скопировал все цитаты (фиолетовый) в другой столбец, скопировал все обзоры (красный) в другой столбец, и т.п.

Образец файла Excel и Word используется: файл

Примечание: имена дел и расположение в прикрепленном выше файле не будут совпадать, так как я уже отредактировал и отсортировал файл Excel. Мне просто нужен макрос для копирования данных, а затем я бы отсортировал его позже. MS Word приходит как есть.

Автор: Frederick Источник Размещён: 28.12.2017 02:38

Ответы (2)


0 плюса

3901 Репутация автора

Я не собираюсь писать код для вас, но чтобы вы начали этот код, если он будет вставлен в модуль vb в Word, он скопирует любой выбранный текст в текущем документе Word в пустую электронную таблицу в Excel.

Sub copytext2XL()
Dim r As Range 'nb this is a Word range, not an Excel range
Dim xl
Dim wb, ws, xlr
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.workbooks.Add
Set ws = wb.worksheets(1)
Set xlr = ws.Range("a1")

Set r = Selection.Range
 r.Copy
 xlr.PasteSpecial 3

End Sub
Автор: Harassed Dad Размещён: 28.12.2017 10:58

0 плюса

4774 Репутация автора

Я бы сказал, что вам нужно получить все в Excel, как таковой.

Sub Sentence_Click()

Dim num As Variant
'Microsoft Word object
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Word document object
Dim WordNam As String
WordNam = "C:\Users\Excel\Desktop\September Week 1 2017.docx"

'Open word document
objWord.Documents.Open WordNam
j = 1
n = objWord.Documents(WordNam).Paragraphs.Count
For Each num In Array(7, 13, 23)
For i = 1 To n
    If i = num Then
        ThisWorkbook.Worksheets(1).Cells(j, 1) = objWord.Documents(WordNam).Paragraphs(i)
        Debug.Print num
        j = j + 1
    End If
Next i
Next num
'Close objects
objWord.Documents.Close
objWord.Quit SaveChanges:=wdDoNotSaveChanges


End Sub

Затем разберите данные в Excel, любым способом, который вы выберете.

Как видите, я импортирую на основе номера абзаца, а не на основе цвета. Я думаю, что вы добавили эти цвета; Я не думаю, что документ приходит к вам так.

Автор: ryguy72 Размещён: 28.12.2017 12:49
32x32