英文を（ ）入の文に変えたい。

質問

A列に英文データがあります。
Many people climb Mt. Fuji every year.
The summer during the 25th of July to 25th of August are the official climbing season.
B列、C列に次のような（　　）入の文を作成したいのです。（　　　）の中には置き換えた単語の最初の1文字を入れたい。B列とC列は（　　　）が交互になります。
英文の暗記用に手で入力していましたが、英文が増えてきましたので、エクセルVBAでうまくできないかお尋ねします。
よろしくお願いします。

B列
Many （p　　） climb （M　　） every （y　　）.

The （s　　） during (t　　） 25th （o　　） July （t　　） 25th （o　　） August （a　　） the （o　　） climbing （s　　）.

C列
（M　　） people （c　　） Mt. Fuji （e　　） year.
（T　　） summer （d　　） the （2　） of （J　　） to （2　　） of （A　　） are （t　） official （c　　　） season.

回答No.2

jcctaira · ベストアンサー

ei60さん　こんにちは。
ユーザ関数にした方が便利だと思います。

Function 問題作成(解答 As String, 開始位置 As Long, Optional 間隔 As Long = 2) As String
　Dim I　　　　 As Long
　Dim 文字分割　As Variant
　文字分割 = Split(解答, " ")
　For I = 開始位置 To UBound(文字分割) Step 間隔
　　　文字分割(I) = " (" & Left(文字分割(I), 1) & "　　)"
　Next I
　問題作成 = Replace(Join(文字分割, " "), "*", " ")
End Function

【使用方法】　A1に解答があるとして
　B1:=問題作成(A1,1)
　C1:=問題作成(A1,0)
注１）第２引数は"("の最初の位置
注２）Mt. Fuji はスペースで区切られていますので、別のワードとして分けられてしまいます。

【蛇足１】
Mt. Fujiの様にスペースがあっても１ワードとしたければ、元の文字列に"*"を使用すれば
ワードを分割しません。結果は"*"をスペースに変換します。
Mt.*Fuji　　→　Mt. Fuji

【蛇足２】
　B1:=問題作成(A1,1,3)
第３引数は括弧の間隔です。例ですと３つおきに"( )" が表示されます。

お試し下さい

お礼

うまくいきました。
なんだか魔法にかかったみたいで感動しました。
ユーザー関数てこんなにうまく処理できるものなのですね。
今まで手作業でしていただけに、その凄さに圧倒されました。

蛇足もすごく参考になりました。
大きな助けをいただいたので、これから英語の学習に頑張りたいと思います。
本当にありがとうございました。

回答No.3

MarcoRossiItaly

No.2 さんのユーザー定義関数、使ったら気持ち良さそうですね。ベストアンサーは辞退します。

ところで、文末のピリオドが単語数によっては ( ) の内部に入ってしまったりしそうですね。これが気になるので外に出したいとなると、VBA の Len 関数で文字数を取得し、Replace で文字数から位置を指定して「.」を除去し、配列への分割・再結合などの処理を行い、最後に「& "."」でくっ付けるといったことになろうかと思います。

それにしても、ご質問の本題とは関係ないですが、ちょっと英文に違和感があるのですが…、そのままでも大丈夫でしょうか？

「during the 25th of July to 25th of August」でも誤りとは言えないと思いますが、「from/during july 25 to august 25」（「25」は「the twenty-fifth」と読む）もしくは「from/during july 25th to august 25th」とすることが多そう。「the 25th」を前に持ってくると、何かその一日が強調されてる感がするというか。普通「are」ではなく「is」と文法上言うことになっていますが、何か特殊な事情がありそうですか？

あるいは、次のように言ってもいいでしょうね。

From July 25 to August 25 is its official climbing season.
Its official climbing season is from July 25 to August 25.
Summer, from July 25 to August 25, is its official climbing season.
Its official climbing season is summer, from July 25 to August 25.

お礼

回答ありがとうございました。
英語のご指摘、とても参考になりました。

これから英語の勉強に励みたいと思います。
ありがとうございました。

回答No.1

tom04

こんばんは！
ちょっとやってみました。
データは1行目からあるとします。
Sheet2を作業用のSheetとして使っていますので、Sheet2は全く使用していないSheetにしてください。
尚、半角スペースで区切っていますので、
＞Mt. Fuji
のように単語の間に半角スペースがあるとお望み通りになりません。
＞Mt.Fuji
だとおそらくご希望通りになると思います。

シートモジュールです。

Sub Sample1()
Dim i As Long, k As Long, j As Long
Dim strB As String, strC As String, bufB As String, bufC As String
Dim wS As Worksheet, myArray
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
myArray = Split(Cells(i, 1), " ")
For k = 0 To UBound(myArray)
wS.Cells(i, k + 1) = myArray(k)
Next k
For j = 1 To wS.Cells(i, Columns.Count).End(xlToLeft).Column
If j Mod 2 = 0 Then
strB = "(" & Left(wS.Cells(i, j), 1) & _
WorksheetFunction.Rept(" ", Len(wS.Cells(i, j))) & ")"
strC = wS.Cells(i, j)
Else
strB = wS.Cells(i, j)
strC = "(" & Left(wS.Cells(i, j), 1) & _
WorksheetFunction.Rept(" ", Len(wS.Cells(i, j))) & ")"
End If
bufB = bufB & strB & " "
bufC = bufC & strC & " "
Next j
Cells(i, 2) = Left(bufB, Len(bufB) - 1)
Cells(i, 3) = Left(bufC, Len(bufC) - 1)
bufB = ""
bufC = ""
Next i
Columns.AutoFit
wS.Cells.Clear
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m（_ _）m

お礼

早速にご回答ありがとうございました。
長いモジュールを組んでいただき感謝します。
No2さんのユーザー関数でうまくいきました。
お手間をかけ重ねて御礼申し上げます。