Excelについて質問します。 英単語を1000個入力して、50個をランダムに抽出したいのですが、可

Excelについて質問します。
英単語を1000個入力して、50個をランダムに抽出したいのですが、可能でしょうか？
できれば、やり方を教えてください。

No.6 回答者： WindFaller 回答日時： 2017/12/10 20:55

続きです。

添付画像で、今のところ、中途半端なスタイルになっていますが、ランダムで出力したものを、フラッシュカード・スタイルで出力するのですが、やった数だけ、1がついていきます。
本来は、逐時モードと連続モードの予定ですが、今の段階では、連続モードと逐時モードがごちゃごちゃになっています。逐時モードは、覚えたかどうかをクリックして、記録するもので、連続モードは、一気に流れていきます。完成までには、まだ試行錯誤が続きそうです。

よいスピークエンジンがあれば、もっとよくなります。
1ヴォイス－4000円程度します。(日本語も売られています。市販のものと、Windowsの添付では雲泥の差があります）

現在、AT&Tはなくなってしまいました。興味があれば、紹介いたします。

これ以上は、ご質問者さんが現れない限りは、発表は控えさせていただく予定にしています。自分が思っている以上のものができるような予感がします。
なお、日本語訳は、古い辞書から学習用の訳つけが可能でしたので、P-DICではないものを利用しました。

なお、私の勝手な判断で、先に進めてしまったことはお詫び申し上げます。
実際は、これをAndroid に応用できるとさらによいでしょう。

'//標準モジュール

Sub WordTest()
　Dim ArWords()
　Dim strt As Long
　Dim T As Long
　Dim K As Long, K1 As Long
　Dim Voice As SpeechLib.SpVoice
　Set Voice = New SpeechLib.SpVoice　'CreateObject("Sapi.SpVoice")
　'参照設定 Microsoft Speech Object Library　'(sapi.dll)
　
　Dim sh1 As Worksheet: Set sh1 = Worksheets("Sheet1")
　Application.EnableCancelKey = xlErrorHandler
　On Error GoTo ErrHandler
　strt = 1
　T = Range("J4").Value
　If T < 5 Or T > 99 Then
　　MsgBox "出題数は、5個からです", vbExclamation
　　Exit Sub
　End If
　K = sh1.Range("J7").Value
　If K <= 0 Then
　　MsgBox "速度係数が存在しないか間違っています。", vbCritical
　　Exit Sub
　End If
　ReDim ArWords(1 To 20, 1 To 2)
　With sh1
　　For i = 1 + strt To 20
　　　ArWords(i, 1) = .Cells(i, "Q").Value
　　　ArWords(i, 2) = .Cells(i, "R").Value
　　Next i
　　For i = 1 To 20
　　 p = i '別のマクロへ
　　　.Range("D6").Value = ArWords(i, 1)
　　　Voice.Speak "<xml><lang langid=""409"">" & ArWords(i, 1) & "</lang></xml>"　'英語
　　　Application.ScreenUpdating = True
　　　Application.Wait Now() + TimeSerial(0, 0, K)
　　　.Range("D9").Value = ArWords(i, 2)
　　　
　　　Voice.Speak "<xml><lang langid=""411"">" & ArWords(i, 2) & " </lang></xml>" '日本語
　　　DoEvents
　　　K1 = Application.Max(2, K - 2)
　　　Application.ScreenUpdating = True
　　　Application.Wait Now + TimeSerial(0, 0, K1)
　　　.Range("D6").Value = ""
　　　.Range("D9").Value = ""
　　　.Cells(i + Start, "P").Value = .Cells(i + Start, "P").Value + 1　'Count
　　Next
　End With
　Application.EnableCancelKey = xlInterrupt
　Exit Sub
ErrHandler:
　With sh1
　　.Range("D6").Value = ""
　　.Range("D9").Value = ""
　End With
　Exit Sub
End Sub
'//
セル情報 D6 から結合セル(3行4列）
D9から結合セル(3行4列）
ランダムの英単語は、Q2から下へ
J4-出題数
j7-速度
j10- 優先
j13 -モード
D12/E12 は、覚えた／覚えられない　の逐時モードのスイッチ予定

No.5 回答者： WindFaller 回答日時： 2017/12/08 10:27

まだ、私は続けています。

（^^;
Excelはなぜか外部オブジェクトのP-DICのユーティリティが組み込めません。ワードはできたようです。ただ、P-DICは、DDEですから、猛烈に遅いです。そで、一行スタイルに出力し、CSVに組み替えてしまいました。

78万行になりました。(ver51 かなり古いものです。学習用は学辞郎が優れています。）

こうやって考えてみると、50個ランダムに出すのは良いにしても、単語暗記は繰り返さなくてはなりません。(ただし、私のやり方は、似た意味のものをなるべく集めるという原則は守りたいです）

一旦、ランダムのインデックスを作ってしまったら、10～50個区切りで出題しなくてはならないはずです。そして、係数(自己申告で覚えたか覚えなかったかの区別の数値化）で管理しなくてはなりません。

後は、音声もつけなくてはなりませんね。

No.4 回答者： WindFaller 回答日時： 2017/12/06 19:01

#3の回答者です。

この先が見えてきません。(私自身が、という意味です）まず、訳を振るマクロというものが、以前は、シャープの翻訳これだけ、とか、IBMの翻訳の王様という学習用のツールがあったのですが、今は、Microsoft Translator 当たりになるけれど、Azure に移行してから、使い方がわからなくなってしまいました。
PDIC一行辞書とかいうものがありますが、うまくいくかどうか分かりません。

No.3 回答者： WindFaller 回答日時： 2017/12/02 16:35

こんにちは。

マクロの処理のほうがきれいにいくと思います。
50個抽出した後の問題が残ります。
実際に、作ってみましょう。

英単語は、画像では一部ですが、著作権フリーの「英語キュレーション」のレベル10を使わせていただきました。
http://wordchunk.azurewebsites.net/View/PC/html/ …
いろんな単語リストの中で、内容的に優れているので、私のお薦めです。

今回は、ランダムで出力するだけのものですが、暗記のためのリストですと、これでは不足しているように思います。繰り返しするということで、間違えたら、カウントを加えていき、多くカウントがついたものから、再び学習し、OK(True)になるまで繰り返すようにしたら良いと思います。ただし、今回のコードは、まだ、バグが残っているようです。

以下は、標準モジュールに貼り付けてください。

'//
Option Explicit

Sub RondomIndex()
'1列目:単語,2列目:Index
　Const NUM As Long = 50
　'シート名(任意)
　Dim sh1 As Worksheet: Set sh1 = Worksheets("Sheet1")
　Dim sh2 As Worksheet: Set sh2 = Worksheets("Sheet2")
　Dim LastRow As Long
　Dim Ar1() As Variant
　Dim Ar2() As Variant
　Dim i As Long, j As Long, mx As Long, cnt As Long
　Dim ret As Variant
　With sh1
　cnt = Application.CountA(.Range("A2:A500"))
　If cnt > 0 And cnt < (NUM * 0.5) Then '0.5 の決まりはない
　 'データがあると誤動作します。
　　If MsgBox("念のために1列目のデータを消去します", vbOKCancel) = vbCancel Then Exit Sub
　 .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).ClearContents
　End If
　End With
　　'1行目はタイトル行
　　'index の2列目で見る
　　LastRow = sh2.Cells(Rows.Count, 1).End(xlUp).Row　'最後尾
　　If sh2.Cells(Rows.Count, 2).End(xlUp).Row < 5 Then
　　 With sh2
　　　ReDim Ar1(1 To LastRow - 1, 0 To 1)
　　　ReDim Ar2(1 To LastRow - 1, 0)
　　　Randomize
　　　For i = 1 To UBound(Ar1, 1)
　　　　Ar1(i, 0) = Rnd()
　　　　Ar1(i, 1) = i
　　　Next
　　　'ランダム番号出力
　　　RankingPos Ar1(), Ar2()
　　　.Cells(2, 2).Resize(LastRow - 1).Value = Ar2
　　End With
　　MsgBox "もう一度実行してください。", vbInformation
　　Else
　　With sh1
　　　j = .Cells(Rows.Count, 1).End(xlUp).Row + 1
　　　mx = j - 1
　　　Application.ScreenUpdating = False
　　　For i = mx To mx + NUM
　　　　ret = Application.Match(i, sh2.Range("B1").Resize(LastRow - 1), 0)
　　　　If IsNumeric(ret) Then
　　　　　If Application.CountIf(sh1.Range("A2:A1200"), sh2.Cells(ret, 1).Value) > 1 Then
　　　　　　'MsgBox sh2.Cells(ret, 1).Value, vbCritical 'ダブリ発見の場合
　　　　　　'stop
　　　　　Else
　　　　　　 .Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = sh2.Cells(ret, 1).Value
　　　　　End If
　　　　End If
　　　Next
　　　Application.ScreenUpdating = True
　　　If LastRow >= mx + NUM + 1 Then
　　　　Application.Goto .Cells(mx + NUM, 1)
　　　Else
　　　　Application.Goto .Cells(Rows.Count, 1).End(xlUp)
　　　　MsgBox "このレベルの最後です", vbInformation
　　　End If
　　　End With
　　End If
　
End Sub
Function RankingPos(Ar(), Ar2())
　Dim i As Long
　Dim j As Long
　Dim Temp As Double, Temp2 As Long
　For i = UBound(Ar, 1) To LBound(Ar, 1) Step -1
　　 For j = LBound(Ar, 1) + 1 To i
　　　If Ar(j - 1, 0) > Ar(j, 0) Then
　　　　Temp = Ar(j - 1, 0)
　　　　Temp2 = Ar(j - 1, 1)
　　　　Ar(j - 1, 0) = Ar(j, 0)
　　　　Ar(j - 1, 1) = Ar(j, 1)
　　　　Ar(j, 0) = Temp
　　　　Ar(j, 1) = Temp2
　　　End If
　　Next j
　　Ar2(i, 0) = Ar(i, 1)
　Next i
End Function
'//
画像

No.2 回答者： 銀鱗 回答日時： 2017/12/02 12:50

自分なら、A列に英単語、B列にRAND関数を入力し、

B列からLARGE関数またはSMALL関数で上位か下位の50個を選択して、それをMATCH関数とINDEX関数を使って表示させる。

LARGE関数やSMALL関数ではなく、RANK関数使って順位を付けて、その1位から50位までに対応する値を表示させるようにしても良いかもしれない。
ただ、この場合は配列数式になるのでお勧めしない。

No.1 回答者： fangfing 回答日時： 2017/12/02 12:28

簡単なマクロを組み込めばサクッとできます

参考
http://www.moug.net/tech/exopr/0090051.html
https://detail.chiebukuro.yahoo.co.jp/qa/questio …