指定した抽選間隔の抽選結果を表示する。

質問

どなたかご存じでしたら回答をお願いします。
数字選択式宝くじの「ミニロト」の抽選結果を毎回エクセルに入力しております。
それを次回の予想に利用しておりますが、「最新抽選結果から第１回目抽選回迄の間で、
ｎ回間隔の抽選結果を抽出する方法」が知りたいです。
例を言うと、【抽選結果シート】の最新抽選結果が180回で、”60回間隔”という指定をすると、
【ｎ回間隔抽選選結果】のように180回を基準として60回前の抽選結果である120回とさらに
そこから60回前の60回の抽選回の結果を抽出する。

【抽選結果シート】
抽選回　　第１数字　第２数字　第３数字　第４数字　第５数字　ボーナス数字
　 1　　　　01　　　　　02　　　　　03　　　　　04　　　　　05　　　　　06
　　2　　　　11　　　　　15　　　　　16　　　　　17　　　　　19　　　　　20
　　　　　　　　　　　　　　　　　　 ---途中省略　----
　　60　　　　03　　　　　07　　　　　10　　　　　20　　　　　25　　　　　06
---途中省略　----
　120　　　　15　　　　　16　　　　　17　　　　　18　　　　　23　　　　　10
---途中省略　----
　180　　　　07　　　　　08　　　　　12　　　　　15　　　　　25　　　　　05

【ｎ回間隔抽選選結果】

抽選回　　第１数字　第２数字　第３数字　第４数字　第５数字　ボーナス数字
　　　60　　　03　　　　　07　　　　　10　　　　　20　　　　　25　　　　　06
　　120　　　15　　　　　16　　　　　17　　　　　18　　　　　23　　　　　10
　　180　　　07　　　　　08　　　　　12　　　　　15　　　　　25　　　　　05

例として60と言ってますが、これは変数なので10とか30といったのに変わります。
エクセルでの操作およびＶＢＡでのソースを教えてください。
また、抽選回に入っているのは数値で、第１数字～ボーナス数字までに入っているのは
文字としています。

以上

回答No.5

MackyNo1 · ベストアンサー

このようなケースでは、単純に抽出したい抽選回を計算し、VLOOKUP関数を使ってその回数のデータを引っ張ってくるのが簡単だと思います。

抽出したい頻度がB1セルに入力してあり、最新の抽選回（関数で計算する場合は「=MAX(抽出結果シート!A:A)」を入力）がD1セルに入力してあるなら、抽出したい抽選回は以下の数式で求められます。

A4セル（1番最初の抽選回）
=IF(MOD($D$1,$B$1)=0,$B$1,MOD($D$1,$B$1))

A5セル（2つ目以降の抽選回、以下下方向にオートフィルコピー）
=IF($A$4+ROW(A1)*$B$1>$D$1,"",$A$4+ROW(A1)*$B$1)

最後に、以下の式をB4セルに入力して右方向および下方向にオートフィルコピーして下さい。

=VLOOKUP($A4,抽出結果シート!$A:$G,COLUMN(B:B),0)

お礼

画像付きの回答を頂きありがとうございます。
早速、試してみます。

回答No.4

MASUKUBO

回答No1です。シート名がSheet1になっていました。次の式に訂正してください。

A2セルからG2せるには抽選結果シートと同じ項目名を入力します。
A3セルには次の式を入力しG3セルまでオートフィルドラッグしたのちに下方にもオートフィルドラッグします。

=IF(ROW(A1)>ROUNDUP(MAX(抽選結果!$A:$A)/$A$1,0),"",INDEX(抽選結果!$A:$G,MAX(抽選結果!$A:$A)+1-(ROW(A1)-1)*$A$1,COLUMN(A1)))

お礼

再度ご回答して頂きありがとうございます。
また試してみます。

回答No.3

tom04

No.2です。

＞昨日の質問の回答に続いてまた・・・

とありますので・・・

実は前回のコードの場合、A列が文字列であれば問題なかったのですが、表示形式だけがユーザー定定義の　"0000"
となっているとちゃんと動作しなかったと思います。

訂正のコードを投稿しようとしたのですが、すでに回答受付を打ち切られていらっしゃったので
今回の質問とは全く関係なくて申し訳ありませんが、この場を借りて昨日のコードの訂正版を投稿させてもらおうと思います。

Sub test()
Dim i, j As Long
Dim str As String
Dim c As Range
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 4
If j <= Len(Cells(i, 1)) Then
Cells(i, j + 1) = Mid(Cells(i, 1), j, 1)
Else
Cells(i, j + 1) = 0
End If
Next j
Set c = Range(Cells(i, 2), Cells(i, 5))
str = WorksheetFunction.Min(c) & _
WorksheetFunction.Small(c, 2) & _
WorksheetFunction.Small(c, 3) & _
WorksheetFunction.Max(c)
With Cells(i, 2)
.Value = str
.NumberFormatLocal = "0000"
End With
Next i
Columns("C:E").Delete
End Sub

これでA列の桁数表示が4桁で実際の桁数が何桁でも対応できると思います。m(_ _)m

お礼

昨日の回答の訂正版まで頂きありがとうございます。
たくさん回答を頂いてたので早く締め切ってしまいました。
申し訳ありませんでした。

回答No.2

tom04

こんにちは！
VBAでの一例です。

Alt＋F11キー　→　画面左側にある「This Workbook」をダブルクリック　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, j, k As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("抽選結果シート")
Set ws2 = Worksheets("sheet2") '←「sheet2」の部分は実際のSheet名に！
For k = 1 To 7
ws2.Cells(1, k) = ws1.Cells(1, k)
Next k
j = ws2.Cells(Rows.Count, 1).End(xlUp).Row
If j > 1 Then
Range(ws2.Cells(2, 1), ws2.Cells(j, 7)).Delete
End If
j = InputBox("間隔数を入力してください。")
For i = ws1.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -j
For k = 1 To 7
ws2.Cells(Rows.Count, k).End(xlUp).Offset(1) = ws1.Cells(i, k)
Next k
Next i
j = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Range(ws2.Cells(2, 1), ws2.Cells(j, 7)).Sort key1:=ws2.Cells(2, 1), order1:=xlAscending
ws2.Columns("A:G").AutoFit
End Sub 'この行まで

こんなんではどうでしょうか？m(_ _)m

お礼

昨日の質問の回答に続いてまた回答頂きありがとうございます。
早速、試させていただきます。

回答No.1

MASUKUBO

抽選結果シートはA1セルからG1セルにわたってお示しの項目名が有り、下方にはそれぞれのデータが入力されているとします。
そこでｎ回間隔抽選選結果シートですがA1セルにはｎ回間隔のｎの数値を例えば60のように入力します。B1セルには回間隔抽選とでも入力します。
A2セルからG2せるには抽選結果シートと同じ項目名を入力します。
A3セルには次の式を入力しG3セルまでオートフィルドラッグしたのちに下方にもオートフィルドラッグします。

=IF(ROW(A1)>ROUNDUP(MAX(Sheet1!$A:$A)/$A$1,0),"",INDEX(Sheet1!$A:$G,MAX(Sheet1!$A:$A)+1-(ROW(A1)-1)*$A$1,COLUMN(A1)))

お礼

早速のご回答ありがとうございます。
頂いたとおりの作業をしたはずですが、結果がでてこないです。
実際にやられた結果添付して頂けると助かります。