[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『メールの内容をエクセルに取り込みテキストを作成する方法』（YU）
現在語学を勉強中なのですが、メルマガなどで送られてきた内容をエクセルに取り込みファイル化する方法を教えていただけないでしょうか？
具体的には
日本語訳 英語フレーズ
これは犬です。 This is a dog.
趣味は読書です My hobby is reading books.
.
.
.
.
のようにエクセルを作成したいのですが教えていただけないでしょうか？
＜ 使用 Excel：Excel2012(Mac)、使用 OS：MacOSX ＞
＞＞＞エクセルに取り込みファイル化する方法
メルマガ本文を自分でコピペするのではなく、これを自動化するという事でしょうか？
要するにメルマガを読み取って
A列：日本語
B列：英語訳
で書き出したいという事でしょうか？
その場合、メルマガの形式はどうなっているんでしょうか？
これは犬です this is a dog
趣味は読書です My hobby is reading books
これはペンです this is a pen
趣味はエクセルです My hobby is excel
・
・
・
というように日本語約+スペース+英語訳といように決まった形で羅列されているとかでないとかなり難しいと思います。
でもそんなメルマガありえないと思いますが・・・
翻訳まで自動でするとかだと更に厳しいと思います。
いずれにしてももう少し詳細を書かないと回答も付かないと思いますよ。
（シー） 2015/06/12(金) 17:13
シーさんのおっしゃる通り情報不足です。
メルマガの形式がHTML形式なのか、テキスト形式なのかわかりませんが、 そのメールアイテムを名前を付けて保存でtxt形式で保存したらエクセルに 取り込むのが容易になります。
またOutlookもExcelもVBAで制御できますので、Outlook VBAとExcel VBAを 連携させてOutlookで受信したメールをテキスト形式で保存してエクセルに 渡す、あるいは、メール内容を直接エクセルに表示、ということも「頑張れ ば」可能です。
Outlookを使わなくてもCDOで制御、ということも考えられます。 ※当方CDOはほとんど扱ったことがないので解説はできませんが。
>使用 Excel：Excel2012(Mac)、使用 OS：MacOSX
当方MaxOS、Mac用Excelを扱ったことがないのでWindows OS、Windows用エ クセルでの方法しかご提案はできません。
詳しい方がいらっしゃればいいのですが。 （カリーニン） 2015/06/12(金) 19:42
need ニード（ドゥ） 必要、必要とする、必要がある
12万人が体験！テレビで話題『速く読む技術』
http://item.rakuten.co.jp/eigo/sokudoku-fy/
【日本語】
新規顧客の開拓のミーティングです。
↓
↓
↓
↓
↓
【英語】
We are meeting to discuss seeking new customers.
12万人が体験！テレビで話題『速く読む技術』
http://item.rakuten.co.jp/eigo/sokudoku-fy/
【日本語】
この会議が３時までに終わることを希望してます。
↓
↓
↓
↓
↓
【英語】
I hope this meeting ends by three o'clock.
wantは、望むの一般的な語、wishは可能か不可能にかかわら
ず望む。hope は望むことを実現が可能と信じている。
ここでは、接続詞のthatが省略されています。
（YU） 2015/06/12(金) 20:18
そのメルマガはtxt形式で保存できますか？ どこまでをメーラーで行い、どこからをエクセルで行いますか？ また、何を手動で行い、何を自動化したいですか？ （カリーニン） 2015/06/12(金) 20:24
もう一つ。 メーラーは何ですか？ （カリーニン） 2015/06/12(金) 20:26
YUさんが、 2015/06/12(金) 20:18に提示された例で、
Excelのシートにはどのように表示したいのですか？
それも併せて提示してください。
単語の説明(needなんたら）とか、必要なんですか？
冒頭の「今夜は少し遅くまで残業してもらいたいのですが。」には、
【日本語】はついていないのですか？
メールの地の日本語と区別がつくのかな。
（γ） 2015/06/12(金) 21:20
前提について質問されているのですから、まずはそれに回答するのが先決ですね。
こんな風にするといいですよ。 Outlookを使用しているという前提で以下書きます。 別のメールソフトでも同様な機能を持っているはずです。
(1)そのメルマガ記事だけ、特定のフォルダに移します。（これは、すでに実行済みでしょう）
(2)そのフォルダの記事を、テキストファイルに「エクスポート」します。
(3)あとは、そのテキストファイルを分析するだけです。
(4)ポイントは、該当箇所だけ抜き出せるかどうかです。
正規表現を使うと可能でしょう。
日本語部分
・【日本語】と"↓" で挟まれたテキスト、と考えて良いでしょう。
英語部分
・【英語】は終端がどこかが不明です。
場合によっては二行で成っている例もありそうです。
ただ、次のセクションとの間には、空行が一行挟まっているようですから、
【英語】から "\n\n"までの間のテキストを取り出せばよいでしょう。
とまあ、こんな説明が可能ですが、 そんなことはどうでもいいから、早く動くコードください、ということかもしれない。 しかし、そうそう自分の都合のいいようにはなりません。 その前に、回答者からの質問に答えるくらいの"汗は掻く"のが礼儀でしょう。
# 本当の目的が英語の上達だとすると、 # Excelに一覧を作ることが、どれだけ有効なことなのか。 # すでにあるメルマガを印刷して、記憶に留める作業に力をいれたほうがいいかもしれないし、 # 手書きのノートに転記する作業のほうが、真の目的を達成する有効手段かもしれない。 # そんなこともチラと考えます。
（γ） 2015/06/14(日) 07:53
質問に対する答えがないが、作ってみたので参考にしてください。 テキストファイルから抽出するところを書きました。 手元でのテストは通りますが、あなたの環境で動くかは保証の限りではありません。
Sub test()
Dim buf As String
'テキストファイルを一括してbufに取り込む
With CreateObject("Scripting.FileSystemObject")
With .GetFile("D:\test\english.txt").OpenAsTextStream
buf = .ReadAll
.Close
End With
End With
Dim ws As Worksheet
Dim Matches As Object
Dim m
Dim s As String
Dim k As Long
'書込先をいったん消去
Set ws = Worksheets("Sheet1")
ws.Columns("A:B").ClearContents
'正規表現を使って、日本語と英語部分を抽出して、シートに書き込む
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.Pattern = "【日本語】\r\n([\s\S]*?)↓|【英語】\r\n([\s\S]*?)\r\n\r\n"
Set Matches = .Execute(buf)
For Each m In Matches
If IsEmpty(m.SubMatches(1)) Then
k = k + 1
s = RTrim(m.SubMatches(0))
ws.Cells(k, 1).Value = Left(s, Len(s) - 2)
Else
ws.Cells(k, 2).Value = m.SubMatches(1)
End If
Next
End With
End Sub
Mac環境だと次のようにするのかもしれない。
.Pattern = "【日本語】\r([\s\S]*?)↓|【英語】\r([\s\S]*?)\r\r"
他にも修正が必要なところがありそうですが、それはそちらで。
また、抽出結果の全行に共通する、行頭のスペース文字は、 必要に応じて、Excel上で置換して消去すればいいでしょう。
（γ） 2015/06/14(日) 13:04
準備： １つのWord文書にメルマガのテキストをまとめておいてください。
実行： １）下記のWordマクロを実行 ２）新規Word文書に日英の対比表が作成されます。 ３）必要ならExcelにコピペしてください。
Sub test()
Dim v() As String
Dim i As Long, n As Long
Dim t As Table
Dim j As Long
With ActiveDocument.Paragraphs
ReDim v(1 To 2, 1 To .Count + 1)
n = 1
v(1, n) = "【日本語】"
v(2, n) = "【英語】"
For i = 1 To .Count
If .Item(i).Range.Sentences(1).Text Like "*【日本語】*" Then
n = n + 1
v(1, n) = .Item(i + 1).Range.Text
ElseIf .Item(i).Range.Sentences(1).Text Like "*【英語】*" Then
v(2, n) = .Item(i + 1).Range.Text
End If
Next
End With
ReDim Preserve v(1 To 2, 1 To n)
Documents.Add
Set t = ActiveDocument.Tables.Add(Selection.Range, n, 2)
For i = 1 To n
For j = 1 To 2
t.Cell(i, j).Range.Text = LTrim(v(j, i))
Next
Next
End Sub
（マナ） 2015/06/14(日) 22:05
私のはそのままでは使えないと思いました。 Mac環境では、FSO も VBScript.RegExp の正規表現も使えないのですね。 （テキストファイルの一括読み込みはFSO以外にも手はあるでしょうけど、 正規表現が使えないのは痛いですね。）
(参考) 「Mac版Excel(Office2011）のVBAを使う場合の注意点」 http://qiita.com/sjuny/items/d3bf8e4dd9e609374575 Excel2012でも同様でしょう。
こう考えると、Mac版というのは、 コード作成の丸投げをするには不向きな環境、と言えるでしょうね。
--------------- そう言う意味でWordのみで対応するのは慧眼ですね。
なお、参考までに申し上げると、 日本語、英語部分ともに、一行(一段落？)とは限らないようですよ。 参考： http://archive.mag2.com/0000090799/index.html ↑たぶん、この系列なんでしょう。
（γ） 2015/06/15(月) 06:12
・日本語は、↓の前の段落まで ・英語は、空行の前の段落まで
Sub test2() Dim s As String Dim v Dim w() As String Dim i As Long, n As Long Dim t As Table Dim j As Long
s = ActiveDocument.Content.Text s = Replace(s, Chr(10), Chr(13)) s = Replace(s, Chr(11), Chr(13)) s = Replace(s, Chr(34), Chr(13)) v = Split(s, Chr(13))
ReDim w(1 To UBound(v) + 2, 1 To 2) n = 1 w(n, 1) = "【日本語】" w(n, 2) = "【英語】"
For i = 0 To UBound(v)
If InStr(v(i), "【日本語】") > 0 Then
n = n + 1
Do While InStr(v(i + 1), "↓") = 0
i = i + 1
w(n, 1) = w(n, 1) & LTrim(v(i)) & Chr(13)
Loop
ElseIf InStr(v(i), "【英語】") > 0 Then
Do While Len(LTrim(v(i + 1))) > 1
i = i + 1
w(n, 2) = w(n, 2) & LTrim(v(i)) & Chr(13)
Loop
End If
Next
Documents.Add
Set t = ActiveDocument.Tables.Add(Selection.Range, n, 2)
For i = 1 To n
For j = 1 To 2
t.Cell(i, j).Range.Text = w(i, j)
Next
Next
End Sub
動作確認の繰り返しで昼休みつぶれちゃいました ★☆を目印にしてもよかったかも。
（マナ） 2015/06/15(月) 12:51
マナさん、どうもです。
Wordマクロの勉強になります。ありがとうございます。
複数行あるときに、頭をそろえるために、こんな風にしてみました。 （ ■を付けた部分以外は、変えておりません。 ）
Sub test2()
Dim s As String
Dim v
Dim w() As String
Dim i As Long, n As Long
Dim t As Table
Dim j As Long
s = ActiveDocument.Content.Text
s = Replace(s, Chr(10), Chr(13))
s = Replace(s, Chr(11), Chr(13))
s = Replace(s, Chr(34), Chr(13))
v = Split(s, Chr(13))
ReDim w(1 To UBound(v) + 2, 1 To 2)
n = 1
w(n, 1) = "【日本語】"
w(n, 2) = "【英語】"
For i = 0 To UBound(v)
If InStr(v(i), "【日本語】") > 0 Then
n = n + 1
Do While InStr(v(i + 1), "↓") = 0
i = i + 1
w(n, 1) = w(n, 1) & v(i) & Chr(13) '■
Loop
w(n, 1) = Replace(w(n, 1), " ", "") '■
ElseIf InStr(v(i), "【英語】") > 0 Then
Do While Len(LTrim(v(i + 1))) > 1
i = i + 1
w(n, 2) = w(n, 2) & v(i) & Chr(13) '■
Loop
w(n, 2) = Replace(w(n, 2), " ", "") '■
End If
Next
Documents.Add
ActiveDocument.PageSetup.Orientation = wdOrientLandscape '■
Set t = ActiveDocument.Tables.Add(Selection.Range, n, 2)
For i = 1 To n
For j = 1 To 2
t.Cell(i, j).Range.Text = w(i, j)
Next
Next
End Sub
それにしても、せっかくコードの提示があったのに、放置ですか。 ちょっと失礼だなあ。
（γ） 2015/06/18(木) 21:46
Wordの検索機能はExcelより高機能なので と思って考えはじめて、試行錯誤を繰り返し、 出来上がったものを見返すと、 Wordでなくてもよかった？みたいです。
Sub test3()
Dim ff, f, fn As Long
Dim k As Long
Dim v() As String
Dim w() As String
Dim i As Long, n As Long
ff = Application.GetOpenFilename( _
FileFilter:="テキストファイル (*.txt),*.txt", _
MultiSelect:=True)
If Not IsArray(ff) Then MsgBox "キャンセル": Exit Sub
For Each f In ff
fn = FreeFile
Open f For Input As #fn
Do While Not EOF(fn)
k = k + 1
ReDim Preserve v(1 To k)
Line Input #fn, v(k)
Loop
Close #fn
Next
ReDim w(1 To k + 1, 1 To 2)
n = 1
w(n, 1) = "【日本語】"
w(n, 2) = "【英語】"
For i = 1 To k
If InStr(v(i), "【日本語】") > 0 Then
n = n + 1
Do While InStr(v(i + 1), "↓") = 0
i = i + 1
w(n, 1) = w(n, 1) & v(i) & Chr(10)
Loop
w(n, 1) = Replace(w(n, 1), " ", "")
ElseIf InStr(v(i), "【英語】") > 0 Then
Do While Len(LTrim(v(i + 1))) > 1
i = i + 1
w(n, 2) = w(n, 2) & v(i) & Chr(10)
Loop
w(n, 2) = Replace(w(n, 2), " ", "")
End If
Next
With Worksheets.Add
With .PageSetup
.PaperSize = xlPaperA4
.Orientation = xlLandscape
End With
.Range("a1").Resize(n, 2).Value = w
.Columns("a:b").ColumnWidth = 60
.Range("a1").CurrentRegion.EntireRow.AutoFit
End With
End Sub
返事いただけないのは、慣れているというか 自分の勉強のために書いているので気にはならないです。
（マナ） 2015/06/19(金) 19:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.