Привет, сообщество StackOverflow. Я новичок в кодировании VBA и пытаюсь импортировать данные таблицы из документа Word в Excel.
Количество таблиц в документе Word будет зафиксировано на уровне 5, равно как и количество строк и столбцов в каждой конкретной таблице.
Мне удалось импортировать все данные, но я не могу понять следующий шаг, где я хотел бы отформатировать импортированные данные.
Пожалуйста, посмотрите на вставленные фотографии ниже результата, который я получаю, и результат, который я хотел бы получить.
Результат, который я хочу получить
Пожалуйста, найдите код, который я написал ниже:
Sub CommandButton1_Click()
'Declare variables
Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Integer
Dim irow As Long
Dim icolumn As Long
row_number = 1
col_number = 1
'Open specific Word-document to import table
wdFileName = Application.GetOpenFilename("Word File(*.docx), *.docx", , "Select Word File", , False)
If wdFileName = False Then Exit Sub
Set wdDoc = GetObject(wdFileName)
With wdDoc
'Count the number of tables
tableNo = .tables.Count
If tableNo = 0 Then
MsgBox "There are no tables in the specified Word Document. Please select the correct Word Document"
Else
'Import of text/data in the tables from Word-document to specified range in Excel. Starts with table 1, then 2 and so on
For i = 1 To 1
With .tables(i)
For icolumn = 1 To .Rows.Count
Application.Range("C6:D7").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
Application.Range("C6:D7").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)
col_number = col_number + 1
row_number = row_number + 1
Next icolumn
End With
Next i
For i = 2 To 2
With .tables(i)
For icolumn = 1 To .Rows.Count
Application.Range("C7:D8").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
Application.Range("C7:D8").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)
col_number = col_number + 1
row_number = row_number + 1
Next icolumn
End With
Next i
For i = 2 To 2
With .tables(i)
For icolumn = 1 To .Rows.Count
Application.Range("C8:D9").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 3).Range.Text)
Application.Range("C8:D9").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 4).Range.Text)
col_number = col_number + 1
row_number = row_number + 1
Next icolumn
End With
Next i
For i = 3 To 3
With .tables(i)
For icolumn = 1 To .Rows.Count
Application.Range("C9:D10").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
Application.Range("C9:D10").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)
Application.Range("C9:D10").Cells(col_number, 3).Value = WorksheetFunction.Clean(.cell(icolumn, 3).Range.Text)
Application.Range("C9:D10").Cells(col_number, 4).Value = WorksheetFunction.Clean(.cell(icolumn, 4).Range.Text)
Application.Range("C9:D10").Cells(col_number, 5).Value = WorksheetFunction.Clean(.cell(icolumn, 5).Range.Text)
Application.Range("C9:D10").Cells(col_number, 6).Value = WorksheetFunction.Clean(.cell(icolumn, 6).Range.Text)
Application.Range("C9:D10").Cells(col_number, 7).Value = WorksheetFunction.Clean(.cell(icolumn, 7).Range.Text)
Application.Range("C9:D10").Cells(col_number, 8).Value = WorksheetFunction.Clean(.cell(icolumn, 8).Range.Text)
col_number = col_number + 1
row_number = row_number + 1
Next icolumn
End With
Next i
For i = 4 To 4
With .tables(i)
For icolumn = 1 To .Rows.Count
Application.Range("C10:D11").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
Application.Range("C10:D11").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)
col_number = col_number + 1
row_number = row_number + 1
Next icolumn
End With
Next i
For i = 5 To 5
With .tables(i)
For icolumn = 1 To .Rows.Count
Application.Range("C11:D12").Cells(col_number, 1).Value = WorksheetFunction.Clean(.cell(icolumn, 1).Range.Text)
Application.Range("C11:D12").Cells(col_number, 2).Value = WorksheetFunction.Clean(.cell(icolumn, 2).Range.Text)
col_number = col_number + 1
row_number = row_number + 1
Next icolumn
End With
Next i
End If
End With
End Sub
Я надеюсь, что сообщество может помочь с этим :)
Привет @freeflow Дело в том, что я не хочу открывать документ Word и просто вставлять таблицы в Excel. Я написал код так, чтобы он работал с кнопкой управления ActiveX, поэтому все, что мне нужно сделать, это выбрать текстовый документ, а затем все будет импортировано в Excel.
Как правильно указал свободный поток, необходимую информацию можно найти в ответе, данном в связанном вопросе.
Что ж, я не понимаю ваш комментарий, поскольку первое, что вы делаете в опубликованном коде, - это доступ к открытому документу Word. Вам нужно прочитать последнюю часть ссылки, где показано копирование и вставка из Excel в Word. Вы можете игнорировать всю преамбулу в связанном примере, связанную с открытием документа Word, поскольку у вас уже есть открытый документ Word.
Что такое номер ячейки для заказа на поставку? это С6
Транспонировать строки и столбцы, кроме таблицы 3.
Sub CommandButton1_Click()
Dim wdDoc As Object, wdFileName As Variant, tbl As Word.Table
Dim ws As Worksheet, rng As Range, tableNo As Integer
Dim r As Long, c As Long
'Open specific Word-document to import table
wdFileName = Application.GetOpenFilename("Word File(*.docx), *.docx", , "Select Word File", , False)
If wdFileName = False Then Exit Sub
Set wdDoc = GetObject(wdFileName)
'Count the number of tables
tableNo = wdDoc.Tables.Count
If tableNo < 5 Then
MsgBox "There are not 5 tables in the specified Word Document. Please select the correct Word Document", vbExclamation
Exit Sub
End If
Set ws = ActiveSheet 'ThisWorkbook.Sheet(1) '
For tableNo = 1 To 5
Set tbl = wdDoc.Tables(tableNo)
Select Case tableNo
Case 1:
Set rng = ws.Range("C6") ' top left corner
' transpose rows / cols
For r = 1 To 2
For c = 1 To 2
rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
Next
Next
Case 2:
Set rng = ws.Range("C9")
' transpose rows / cols
For r = 1 To 2
For c = 1 To 3
rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
Next
Next
Set rng = ws.Range("C12")
' transpose rows / cols
For r = 3 To 4
For c = 1 To 3
rng.Offset(r - 3, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
Next
Next
Case 3:
Set rng = ws.Range("C17")
For r = 1 To tbl.Rows.Count
For c = 1 To 8
rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(r, c).Range.Text)
Next
Next
Case 4:
Set rng = ws.Range("C26")
' transpose rows / cols
For r = 1 To 2
For c = 1 To 3
rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
Next
Next
Case 5:
Set rng = ws.Range("C29")
' transpose rows / cols
For r = 1 To 2
For c = 1 To 4
rng.Offset(r - 1, c - 1) = WorksheetFunction.Clean(tbl.cell(c, r).Range.Text)
Next
Next
End Select
Next
Set wdDoc = Nothing
MsgBox "Done", vbInformation
End Sub
Попробуйте скопировать диапазон таблицы в Word, а затем вставить форматированный текст в Excel, как описано здесь stackoverflow.com/questions/12245525/…