エクセルでVBE作成

Question

I want to eat an apple.
What do you want to drink?

このような英文データがたくさんあります。これをアットランダムで
１）単語をばらばらにした文
I 　tanw 　ot　 tae 　na　 lpepa　.
ahtw　 od 　oyu 　nwta　 ot　 rkdni　?

２）文をばらばらにした文
an  　 to 　 apple　  I 　 eat　   want　 .
want  　do 　 drink　 what　 you　 to 　?　

ＶＢＥを使って作ることはできますか、教えてください。
よろしくお願いします。

Wendy02 · Accepted Answer

こんにちは。

すみません。やっと意味が分かりました。
もう少し、きちんと読んでいればよかったです。

'I'（私） のみは、大文字ということですね。

私は、その意味を理解できていませんでした。それは、考えてもみなかったです。

こうなればよいのですね。
-------------------------------------------
I am from China.　　　　from I am China .
What is this?　　　　is this what ?
Shall I open the door?　　　　door I open shall the ?
--------------------------------------------

にするためには、先頭の文字を小文字にするオプションとして、

'先頭の文字を小文字にするオプション
'先頭から2文字のI（大文字のI)+" "(半角スペース）は除外
　If StrComp(Mid$(buf, 1, 2), "I ", vbBinaryCompare) <> 0 Then
　　 buf = StrConv(Mid$(buf, 1, 1), vbLowerCase) & Mid$(buf, 2)
　End If

このようなオプションを入れてください。

この場合、先頭から2文字のI（大文字のI)+" "(半角スペース）のみになっているものに対しては除外されます。ただし、固有名詞に関しては、小文字になってしまいます。その場合、辞書として、リストを作らなくてはなりません。WorksheetFunction.Match(検索語,リスト,0) として、ヒットした場合は、除外ということになります。少し、またコードが難しくなります。

Wendy02 · Answer

こんばんは。

返事が遅くなりました。

>先頭の文字を小文字にするオプション　　←【不要】
>'割愛　　←【不要】
>となっていますので
>buf = StrConv(Mid$(buf, 1, 1), vbLowerCase) & Mid$(buf, 2)
>を入れて実行しますと

何も手を加えないで、そのまま使ってください。「割愛」とい言葉、入れてくださいという意味ではありません。単に、私自身の記録のために入れたので、「割愛」という言葉は無視してください。それは、入れたら、小文字になります。

Wendy02 · Answer

こんにちは。

>文頭の単語は小文字に変換します。
>ただ、いつも大文字でないといけない　「私はの　I」 までが　小文字の　i　に変わると>困るのです。 「私はの　I」 だけはいつも　I にしておきたいのです。

ご質問が良く理解できません。その部分は前回から説明したはずで、最初のコードでも、私の指摘した部分で修正が利くはずです。ただ、それを再度指摘されたので、分からないと思い修正をして、#8で新たに書き出しました。#8のコードだけで出来るはずです。

私の出した出来上がりのサンプル文が、想定していない部分があるなら、ご指摘ください。

this that rise day up nation will a live meaning out its true of dream the one have creed and I .

この最後の"I" になりますが、これは、元の文章がそうなっているからです。元の文が、大文字のI を入れる限りは、"I" になるはずです。小文字で入れているなら別です。意味が違いますか？

今回のマクロは、どこにも大文字・小文字の変更はさせていないはずです。登録されたマクロを調べていただけませんか？チェックする方法は、（VBEの左枠をクリックすると●が入る）ブレークポイントを取って、そのコードが通っているか調べてみれば分かります。マクロを走らせると、その部分でとまります。

今までのマクロのコードが混じっているのではありませんか？
前のものが修正がされていないなら、残さずに削除してください。もしくは、新規のシートのVBEditor で、標準モジュールを挿入して、#8のコードで試してみてください。

大文字を小文字に変更するのは、StrConvというVBA関数で、引数は、vbLower というものです。検索で、StrConv を探し、引数にvbLower という名称が入っているものがあれば、その部分で小文字にしますから、その部分のコードは違いますから、削除してください。

また、こちらが、全面的に意味を取り違えているなら、ご指摘ください。その場合は、直します。

Wendy02 · Answer

こんばんは。

#6 の補足
>私は　の　I 　 が　i 　 になってしまうのが困っていました。
>自分でいろいろやってみるのですが、うまくいきません。
>よろしくお願いします。

前のものとコードが交じり合っているようですね。
一応、最終校として、もう一度、アップしておきますので、これも、別の標準モジュールに入れて、前のものは削除してしまえば、交じり合うこともないと思います。

今回の並べ替え

I have a dream that one day this nation will rise up and live out the true meaning of its creed.
　　　　↓
this that rise day up nation will a live meaning out its true of dream the one have creed and I .

それから、細かいことですが、この並べ替えには、長く繰り返していると、なぜか、癖を感じることがあります。一応、乱数ジェネレータの初期化はしているのですが、これは、パソコン自体の限界だと思ってください。

それと、少し直したのは、数千回に1度かそれ以下の確率で、元の文とまったく同じ並びに出てくる可能性があります。少なくとも、10数単語レベルでは、いくらランダムでも同じものが出てきますので、同一の場合は、再シャフルするためのループを設けました。

もう一つは、最初のご質問では、最後尾の[.（ピリオド)][!(エクスクラメーション]) などは、並べ替えられても最後尾に来ているようでしたので、それも修正しました。
なお、現行では、英語のみです。フランス語などの場合は、Unicode 扱いになりますので、最初の2バイト文字・チェックの部分が変わります。

#7 の問題、辞書をみないで、foul と tummy は、しばらく考えてしまいましが、なんとか解けます。VBAでも、もちろん可能です。
問題は、大学入試レベルぐらいだと思いました。私も、英語が主ですが、あまりに英語が上達しないので、暇つぶしに、VBAを言語として学びました。語学の勉強の仕方と、非常に良く似ていますが、聴くこと話すことはないので、少なくとも英語よりは、遥かに簡単です。単語だって、1,000語も覚える必要はありません。

もし、ついでもありましたら、ご質問を加えてください。この際、出来ることは協力します。久々に、楽しませていただいております。

--------------------------------------------------------
Sub RandamPickUpWords2()
　　Dim c As Variant
　　Dim buf As Variant
　　Dim org As String
　　Dim m As Long
　　Dim i As Long, j As Integer
　　Dim e As Integer
　　Dim arBuf As Variant
　　Dim tmp As String
　　Dim lastwd As String
　　i = 1 '書き出しの行の初期値
　　j = 3 '書き出しの列の初期値
　　Application.ScreenUpdating = False
　　For Each c In Range("A1", Range("A65536").End(xlUp))
　　　　'2バイト文字除外チェック
　　　　If VarType(c.Value) = vbString Then
　　　　　　buf = StrConv(Trim(c.Value), vbNarrow)
　　　　　　org = buf
　　　　　　'先頭の文字を小文字にするオプション
　　　　　　'割愛
　　　　　　If Len(buf) = LenB(StrConv(buf, vbFromUnicode)) Then
　　　　　　　　'修正箇所
　　　　　　　　If Right(buf, 1) Like "[!-@]" Then
　　　　　　　　　　lastwd = Right$(buf, 1)
　　　　　　　　　　buf = Mid$(buf, 1, Len(buf) - 1)
　　　　　　　　End If
　　　　　　　　buf = Split(buf, Space(1))
　　　　　　　　m = UBound(buf) + 1
　　　　　　　　Do
　　　　　　　　　　arBuf = rndWord(buf, m)
　　　　　　　　　　tmp = Join(arBuf, Space(1))
　　　　　　　　　　e = e + 1
　　　　　　　　　　If e > 10 Then Exit Do '無限ループ保護
　　　　　　　　Loop While Mid$(org, 1, Len(org) - 1) = tmp
　　　　　　　　Cells(i, j).Value = tmp & " " & lastwd
　　　　　　　　i = i + 1
　　　　　　　　lastwd = ""
　　　　　　End If
　　　　End If
　　Next c
　　Application.ScreenUpdating = True
End Sub

Function rndWord(ar, m)
　 Dim myCol As New Collection
　 Dim arBuf As Variant
　 Dim n As Integer
　 Dim i As Integer, j As Integer, k As Integer
　 ReDim arBuf(UBound(ar))
　 For i = 1 To m
　　myCol.Add ar(i - 1)
　 Next i
　 Randomize
　 For j = m To 1 Step -1
　　 k = Int(Rnd() * j) + 1
　　 arBuf(n) = myCol.Item(k)
　　 myCol.Remove (k)
　　 n = n + 1
　 Next j
　 rndWord = arBuf
　 Erase arBuf
End Function

Wendy02 · Answer

こんばんは。

こちらの勝手なことを考えてしまいましので、ご希望のものとは違うものにしてしまい、たいへんすみませんでした。

できましたら、使用用途を教えていただけるとありがたいです。
問題としては、両方とも作るのは簡単でも、解くほうは、そんなに簡単なものではないと思います。

1. の単語の並べ替え
コードは、前回のものをほとんど流用しました。

　CheckWord()サブルーチンの中の
　　If Len(mWord) > 2 Then
　　を
　　If Len(mWord) > 1 Then

に訂正しました。間違いがありました。
ですから、前の以下の二つは削除して、
Private Sub CheckWord(ByRef mWord As String)
Function rndChar(mWord As String)
別の標準モジュールを追加して、そちらに置いたほうが分かりやすいと思います。

--------------------------------------------------------
Sub RandamWordsSentence()
　　'センテンスはそのままで単語だけ入れ替える
　　Dim c As Variant
　　Dim buf As Variant
　　Dim ArBuf() As String
　　Dim tmp As String
　　Dim m As Long
　　Dim i As Long, j As Integer, k As Integer
　　Dim lastwd As String
　　i = 1 '書き出しの行の初期値
　　j = 3 '書き出しの列の初期値
　　For Each c In Range("A1", Range("A65536").End(xlUp))
　　　　'2バイト文字除外チェック
　　　　If VarType(c.Value) = vbString Then
　　　　　　buf = StrConv(Trim(c.Value), vbNarrow)
　　　　　　'buf = StrConv(Mid$(buf, 1, 1), vbLowerCase) & Mid$(buf, 2)
　　　　　　If Len(buf) = LenB(StrConv(buf, vbFromUnicode)) Then
　　　　　　　 '最後尾のピリオド分離
　　　　　　　 If Right(buf, 1) Like "[!-@]" Then
　　　　　　　　lastwd = Right(buf, 1)
　　　　　　　　buf = Mid$(buf, 1, Len(buf) - 1)
　　　　　　　 End If
　　　　　　　　buf = Split(buf, Space(1))
　　　　　　　　ReDim ArBuf(UBound(buf))
　　　　　　　　For n = LBound(buf) To UBound(buf)
　　　　　　　　　tmp = buf(n)
　　　　　　　　　CheckWord tmp
　　　　　　　　　ArBuf(n) = tmp
　　　　　　　　Next
　　　　　　　　Cells(i, j).Value = Join(ArBuf(), Space(1)) & " " & lastwd
　　　　　　　　i = i + 1
　　　　　　End If
　　　　End If
　　Next c
End Sub
Private Sub CheckWord(ByRef mWord As String)
'戻り値が同じ文字列を排除するためのサブルーチン
Dim a As String
　 If Len(mWord) > 1 Then
　 a = rndChar(mWord)
　Do While mWord = a
　 a = rndChar(mWord)
　Loop
　mWord = a
　End If
End Sub

Function rndChar(mWord As String)
'ランダム文字並べ替え
　Dim buf As String
　Dim myCol As New Collection
　Dim n As Integer
　Dim i As Integer, j As Integer, k As Integer
　buf = ""
　n = Len(mWord)
　If n <= 1 Then rndChar = mWord: Exit Function
　If n = 2 Then rndChar = Mid$(mWord, 2, 1) & Mid$(mWord, 1, 1): Exit Function
　
　For i = 1 To Len(mWord)
　　myCol.Add Mid(mWord, i, 1)
　Next i
　Randomize
　 For j = n To 1 Step -1
　　 k = Int(Rnd() * j) + 1
　　 buf = buf & myCol.Item(k)
　　 myCol.Remove (k)
　　 n = n + 1
　 Next j
　　rndChar = buf
End Function

Wendy02 · Answer

#4 のコード

すみません! もともと、わたし用のために作ったので(^^ゞ

　'先頭の文字を小文字にするオプション
　buf = Mid$(buf, 1, Len(buf) - 1) & " " & lastwd
　　↓
  'buf = Mid$(buf, 1, Len(buf) - 1) & " " & lastwd
'その行を削除するか、「'」シングルクォーテーションを入れてください。
 
#5 のほうは、改めてアップします。少しお時間ください。簡単ですから、すぐに出来ます。

Wendy02 · Answer

追加です。

Sub RandamPickUpWords()
は同じですが、1. の文字並べ替えバージョンを加えました。
しかし、この問題は、さっぱり分かりませんね。

---------------------------
Function rndWord(ar, m)
　 Dim myCol As New Collection
　 Dim arBuf As Variant
　 Dim n As Integer
　 Dim i As Integer, j As Integer, k As Integer
　 Dim myWord As String
　 ReDim arBuf(UBound(ar))
　 For i = 1 To m
　　myWord = ar(i - 1)
　　Call CheckWord(myWord)
　　myCol.Add myWord
　 Next i
　 Randomize
　 For j = m To 1 Step -1
　　 k = Int(Rnd() * j) + 1
　　 arBuf(n) = myCol.Item(k)
　　 myCol.Remove (k)
　　 n = n + 1
　 Next j
　 rndWord = arBuf
　 Erase arBuf
End Function
Private Sub CheckWord(ByRef mWord As String)
'戻り値が同じ文字列を排除するためのサブルーチン
Dim a As String
　 If Len(mWord) > 2 Then
　 a = rndChar(mWord)
　Do While mWord = a
　 a = rndChar(mWord)
　Loop
　mWord = a
　End If
End Sub

Function rndChar(mWord As String)
'ランダム文字並べ替え
　Dim buf As String
　Dim myCol As New Collection
　Dim n As Integer
　Dim i As Integer, j As Integer, k As Integer
　buf = ""
　n = Len(mWord)
　If n <= 1 Then rndChar = mWord: Exit Function
　If n = 2 Then rndChar = Mid$(mWord, 2, 1) & Mid$(mWord, 1, 1): Exit Function
　
　For i = 1 To Len(mWord)
　　myCol.Add Mid(mWord, i, 1)
　Next i
　Randomize
　 For j = n To 1 Step -1
　　 k = Int(Rnd() * j) + 1
　　 buf = buf & myCol.Item(k)
　　 myCol.Remove (k)
　　 n = n + 1
　 Next j
　　rndChar = buf
End Function

Wendy02 · Answer

こんばんは。

>これは元データを本文とピリオド、クエスチョンマークに分離して解決しました。
> china などの大文字だけがネックですが、これは手作業で変換します。

これらは、修正しました。

Webサイトの問題表示自体を、私がアレンジしたわけで、実は、「実際の解いた経験」から考えて作ったのです。いつも（"EigoTown.com"で、週に2度ぐらい出てきます）やってきた経験で、「.」が、文字についていないと、その最後尾は非常に難しいと思います。今回は、私の先回りしたアレンジですから、ご質問どおりにしましたので、上書きしてしまってください。

たとえば、こんな文の場合、先頭が、Had なので、これはを、小文字にするわけですが、ピリオド(.) が単語から離れると、これは難しいです。本当は、先頭の文字だけを小文字にすると良いかもしれませんね。

Had I known you were in hospital, I would have visited you.


---------------------------------------------
Sub RandamPickUpWords()
　　Dim c As Variant
　　Dim buf As Variant
　　Dim m As Long
　　Dim i As Long, j As Integer
　　Dim arBuf As Variant
　　Dim lastwd As String
　　i = 1 '書き出しの行の初期値
　　j = 3 '書き出しの列の初期値
　　For Each c In Range("A1", Range("A65536").End(xlUp))
　　　　'2バイト文字除外チェック
　　　　If VarType(c.Value) = vbString Then
　　　　　　buf = StrConv(Trim(c.Value), vbNarrow)
　　　　　　'先頭の文字を小文字にするオプション
　　　　　　'buf = StrConv(Mid$(buf, 1, 1), vbLowerCase) & Mid$(buf, 2)
　　　　　　If Len(buf) = LenB(StrConv(buf, vbFromUnicode)) Then
　　　　　　　'修正箇所
　　　　　　　 If Right(buf, 1) Like "[!-@]" Then
　　　　　　　　lastwd = Right$(buf, 1)
　　　　　　　　buf = Mid$(buf, 1, Len(buf) - 1) & " " & lastwd
　　　　　　　 End If
　　　　　　　　buf = Split(buf, Space(1))
　　　　　　　　m = UBound(buf) + 1
　　　　　　　　arBuf = rndWord(buf, m)
　　　　　　　　Cells(i, j).Value = Join(arBuf, Space(1))
　　　　　　　　i = i + 1
　　　　　　End If
　　　　End If
　　Next c
End Sub

Function rndWord(ar, m)
　 Dim myCol As New Collection
　 Dim arBuf As Variant
　 Dim n As Integer
　 Dim i As Integer, j As Integer, k As Integer
　 ReDim arBuf(UBound(ar))
　 For i = 1 To m
　　myCol.Add ar(i - 1)
　 Next i
　 Randomize
　 For j = m To 1 Step -1
　　 k = Int(Rnd() * j) + 1
　　 arBuf(n) = myCol.Item(k)
　　 myCol.Remove (k)
　　 n = n + 1
　 Next j
　 rndWord = arBuf
　 Erase arBuf
End Function

Wendy02 · Answer

こんにちは。

1) は、問題として、見たことがありません。
　これは、とりあえず、パスさせてください。

2)
これは、以下に出てくるタイプと同じスタイルです。
http://www.eigotown.com/eigocollege/nav.php3?c=2

ピリオドやクエスチョンマークは切り分けはしておりません。
　eat an to apple. want i 
のようなスタイルになります。ExcelのVBE標準モジュールでお使いください。


Sub RandamPickUpWords()
　　Dim c As Variant
　　Dim buf As Variant
　　Dim m As Long
　　Dim i As Long, j As Integer
　　Dim arBuf As Variant
　　i = 1 '書き出しの行の初期値
　　j = 3 '書き出しの列の初期値
　　For Each c In Range("A1", Range("A65536").End(xlUp))
　　　　'2バイト文字除外チェック
　　　　If VarType(c.Value) = vbString Then
　　　　　　buf = StrConv(Trim(c.Value), vbNarrow)
　　　　　　If Len(buf) = LenB(StrConv(buf, vbFromUnicode)) Then
　　　　　　　　buf = Split(buf, Space(1))
　　　　　　　　m = UBound(buf) + 1
　　　　　　　　arBuf = rndWord(buf, m)
　　　　　　　　Cells(i, j).Value = Join(arBuf, Space(1))
　　　　　　　　i = i + 1
　　　　　　End If
　　　　End If
　　Next c
End Sub
Function rndWord(ar, m)
　 Dim myCol As New Collection
　 Dim arBuf As Variant
　 Dim n As Integer
　 Dim i As Integer, j As Integer, k As Integer
　 ReDim arBuf(UBound(ar))
　 For i = 1 To m
　　myCol.Add ar(i - 1)
　 Next i
　 Randomize
　 For j = m To 1 Step -1
　　 k = Int(Rnd() * j) + 1
　　 arBuf(n) = StrConv(myCol.Item(k), vbLowerCase)
　　 myCol.Remove (k)
　　 n = n + 1
　 Next j
　 rndWord = arBuf
　 Erase arBuf
End Function

imogasi · Answer

正しく空白により語の分離が行われておれば、語単位には、Split関数で一発分離可能です。
＞英文データがたくさんあります
どういうファイル形式というかソフト上でデータがあるのか書いてないのも片手落ちです。エクセルのシートのセルのデータになっているの？ワード、メモ帳（テキスト形式）色々あり、テキストにするまでの難しさが違う。
＞ランダムに
ご存知だろうが、順列や組み合わせの数は対象となるのもが少し増えると膨大な数になる。それについてはどう考えているの。
文字順を変えた結果意味的に同行とか考えないのかな。
乱数を使ってできるといっても易しくないし。
ーー
＞VBE作成
エクセルVBAのことをVBEというレベルの方には、ヒントだけでプログラムコードが完成できると思えない。結局他人に丸投げで、回答者に動くコードを作ってくれということになるが、普通のエクセルを事務で使うような（普通のエクセルVBAの課題のような）簡単なものではないし、引き受けられない。
自分で勉強するか、大切なものなら代価を払って業者に頼むしかない。

エクセルでVBE作成

こんにちは。

こんばんは。

この回答への補足

こんにちは。

この回答への補足

こんばんは。

この回答への補足

こんばんは。

#4 のコード

この回答への補足

追加です。

この回答への補足

こんばんは。

この回答への補足

こんにちは。

正しく空白により語の分離が行われておれば、語単位には、Split関数で一発分離可能です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング