WordからExcelへ変換しデータを揃える方法は？

質問

Word文書で複数のセル内にテキストデータがあります。
セル内で改行をしているものも混ざっています。

Excelに変換し、1つのWordファイルにつき、1行でデータベースをつくらねばなりません。

今、地道にしている作業は以下の通りです。

＜Word＞
全て選択　→　コピー　

＜Excel＞
→テキストで貼り付け　→　行列を入れ替えて貼り付け

それでも、セル内で改行をしているものとしていないものでExcelのセルがずれてきます。

Wordのセル内で改行していても、一つのセルとして変換する方法はないでしょうか？

また、うまい方法はないでしょうか？？

1300件ほど処理しなければならず、困っています。
どなたか助けてくださいっ！！

回答No.3

KenKen_SP · ベストアンサー

試しにコードを書いてみました。Excel VBA です。

DOC ファイル内の全ての表を Excel のアクティブシートに行列を入れ替えて
書き出します。ただ、複合表があると、期待どおりの結果は得られないと思い
ます。

Word VBA には結合セルを調べるプロパティーがない？ みたいなので、無理矢理
やってますが、一応それなりに動くようです。

また、エラートラップもほとんどしてません。試してみて、エラー終了したら
タスクマネージャで WINWORD.EXE が残っていないか確認して下さい。

使い方は Excel の 標準モジュールに貼り付け、VBE [ツール]-[参照設定]で

・Microsoft Word x.x Object Lybrary

をチェックしてから実行します。x.x はお使いの OFFICE のバージョンにより
異なります。

少しは役立つかな？　と思ったけど、あんまり役立たない気がしますm(_ _;)m

Sub Sample()

　　Dim WRD　　　　 As Word.Application
　　Dim DOC　　　　 As Word.Document
　　Dim objTable　　As Word.Table
　　Dim objCell　　 As Word.Cell
　　Dim strFilename As String
　　Dim strText　　 As String
　　Dim lngRows　　 As Long
　　Dim lngCols　　 As Long
　　Dim Buffer()　　As String
　　Dim R　　　　　 As Long
　　Dim C　　　　　 As Long

　　Const MARK　　　As String = "$$$$"

　　' DOCファイルの指定
　　strFilename = Application.GetOpenFilename("WORDファイル (*.doc), *.doc")
　　If UCase$(strFilename) = "FALSE" Then
　　　　Exit Sub
　　End If

　　' DOCファイルオープン
　　Application.StatusBar = "[ " & Dir(strFilename) & " ]を開いてます..."
　　Set WRD = New Word.Application
　　WRD.Visible = False ' True の方がいいかも？
　　Set DOC = WRD.Documents.Open(strFilename)

　　' テーブルのコピー＆ペースト
　　Application.StatusBar = "テーブルをコピー中..."
　　For Each objTable In DOC.Tables
　　　　' テーブルサイズを求めてバッファ領域を確保
　　　　With objTable
　　　　　　lngRows = .Rows.Count
　　　　　　lngCols = .Columns.Count
　　　　End With
　　　　ReDim Buffer(1 To lngRows, 1 To lngCols)
　　　　' セル内改行コードを置換しながらバッファ
　　　　For R = 1 To lngRows
　　　　　　For C = 1 To lngCols
　　　　　　　　' 結合セルがあると次行でエラーになります、、、
On Error GoTo ERROR_SKIP
　　　　　　　　strText = objTable.Cell(R, C).Range.Text
　　　　　　　　strText = Replace(strText, Chr(13), MARK)
　　　　　　　　strText = Left$(strText, Len(strText) - Len(MARK) - 1)
　　　　　　　　Buffer(R, C) = strText
ERROR_SKIP:
　　　　　　Next C
　　　　Next R

　　　　' 行列をスワップさせてアクティブシートに転記
　　　　With ActiveSheet.Range("A65536").End(xlUp).Offset(1) _
　　　　　　.Resize(UBound(Buffer, 2), UBound(Buffer))
　　　　　　' 文字列として転記しないなら次行をコメントアウト
　　　　　　.NumberFormatLocal = "@"
　　　　　　' 一括転記(Transpose で行列を入れ替えてます）
　　　　　　.Value = Application.Transpose(Buffer)
　　　　　　' セル内の改行コードを元に戻す
　　　　　　.Replace What:=MARK, Replacement:=vbLf
　　　　End With
　　Next objTable

　　' WORD フィイルを閉じてアプリケーションを開放
　　Application.StatusBar = "[ " & Dir(strFilename) & " ]を閉じています..."
　　DOC.Close SaveChanges:=False
　　Set DOC = Nothing
　　Application.StatusBar = ""
　　WRD.Quit
　　Set WRD = Nothing

End Sub

お礼

うわっ、ご丁寧にありがとうございます。ちょっと頑張ってみます。
とりあえず、お礼まで。

回答No.2

KenKen_SP

こんにちは。

VBA でセル内の改行コードを例えば $$$$ などの記号に置換し、Excel に
貼り付けてからまた $$$$ を改行コードに置換し直せばある程度の自動化
は可能かと、、

> ... 1つのWordファイルにつき、1行でデータベースを...
> ＜Word＞
> 全て選択　→　コピー　

Word ファイルからコピーするのは「表」だけですか？ 他に文章とかは？

お礼

ありがとうございました。
ちょっとわからないので、周りに聞いてみます、、。

全てのデータが各セル内に収まってます。

回答No.1

enunokokoro

Word側で表の解除をするときに、段落記号で区切って
みては。

メニューの[罫線]→[変換]→[表の解除]で区切りを
[段落記号]にします。

段落ごとに区切られたら、コピーしてExcelに貼り付け
をします。

Wordの文書は上書き保存しなければ良いのですから。

お礼

ありがとうございます。やってみたものの、結果は今までと同じになってしまいました。

Wordのセルで
(1)改行してあり、数行になって入っているデータ
(2)一行のみのデータ
　　↓　Excelに貼り付けすると
(1)は数列のセルにわたって変換される。
(2)は1セルに収まる。

これを(1)も1セルに納めたいのです、、、。