[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ExcelVBAで重複データを調べランダムに数字を作成』（fairlady）
こちらのサイトはよく参考にしており、今回初の投稿になります。宜しくお願いいたします。
仕事でもExcelをよく使っていますが、まだまだスキルが足りないと思い、独学で学んでおります。
それにあたり、何かよい題材がないかと思い、たまに買う数字選択宝くじを思い浮かべ
自分で色々表を作成して、多少関数など使えるようになったのですが、如何せん
手作業では、沢山できた表を管理出来なくなってきました。そこで今まで敷居が高く、
避けてきたVBAを学ぼうと思い色々なサイトを探して、こんなコードをみつけて、
Excelで数字をランダムに作成し、自分で作った表の過去データと重複していないか
確認しようと思ったのですが、うまくコードが書けません。
沢山のサイトを調べたのですが、いきずまっての投稿になります。
そこで今回の質問内容ですが、
１ Sheet1で数字を６個ランダムに１００通り組合せを作る
２ Sheet2に過去のデータをB2〜G2以下に毎回入れる
※ １での作成時にSheet2の過去のデータと今までに出た組み合わせでないか判定
のループをさせたいのだがここが分かりません。
そのコードがこちらになります。（恥ずかしいですがコメントは、覚える為に私が
書きましたので間違ってる事と思います）
Sub Main()
Dim r As Integer, c As Integer 整数を入れるInteger型（整数）範囲は、-32,768 〜 +32,767
Dim i As Integer, j As Integer, k As Integer Long型（長整数）範囲は、-2,147,483,648 〜 +2,147,483,647
Dim LastRow As Integer 変数の宣言。出力先の行番号を格納する
Dim Rng As Range セル範囲の操作を行うため、Range型の変数
Dim Flg As Boolean FlgがTrueまたはFalseのいずれかを格納するときにブール型
Flg = True フラグを立てる＝条件（真）
r = 2
c = 1
Cells.ClearContents セルのコメント値クリア
Do While r <= 101 条件式を満たすまで繰り返す処理
With Cells(r, 1) Withを使って主語(操作の対象)を省略する
.Value = r - 1 セルの指定方法
.Font.ColorIndex = 5 フォントの文字色を設定
End With 同じオブジェクトに対して複数の処理を実行する
'6つのランダム数字を振る
For c = 2 To 7
Cells(r, c).Value = Application.WorksheetFunction.RoundUp(Rnd() * 43, 0)
Next c
Set Rng = Range(Cells(r, 2), Cells(r, 7))
Rng.Sort _
key1:=Cells(r, 1), _
Order1:=xlAscending, _
Orientation:=xlLeftToRight
'同じ行に同一数値が無いかの判定
For c = 2 To 6
If Cells(r, c).Value = Cells(r, c + 1).Value Then
Rng.ClearContents
Flg = False
Exit For
End If
Next c
'この数値の６つが今までに出た組み合わせでないか判定
For k = r - 1 To 2 Step -1
i = 1
For c = 2 To 7
If Cells(r, c).Value <> Cells(k, c).Value Then
i = i * 0
End If
Next c
If i = 1 Then
Rng.ClearContents
Flg = False
Exit For
End If
Next k
'両方OKの場合次へ
If Flg = True Then
r = r + 1
ElseIf Flg = False Then
Flg = True
End If
Loop
Set Rng = Nothing
End Sub
なにせVBA初心者な者ですので、コードのコメントも教えてくれれば、助かります。
なにとか御教示頂けたら幸いです。
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
まずはインデントを付けましょう。
>Excelで数字をランダムに作成し、自分で作った表の過去データと重複していないか >確認しようと思ったのですが、うまくコードが書けません。
ちょっとだけ手直ししてみましたが、基本今のコードで動いていませんか？
Option Explicit
Sub LOTOSIX()
'整数を入れる
'Integer型Integer型の範囲は、-32,768 〜 +32,767
'Long型の範囲は、-2,147,483,648 〜 +2,147,483,647
Dim r As Long, c As Long ' ★ 特に意識しないなら整数は Long にした方が無難。 2003 でも 65536 行まで使える。
Dim i As Long, j As Long, k As Long
Dim LastRow As Long '変数の宣言。出力先の行番号を格納する
Dim Rng As Range 'セル範囲の操作を行うため、Range型の変数
Dim Flg As Boolean 'FlgがTrueまたはFalseのいずれかを格納するときにブール型
Flg = True 'フラグを立てる＝条件（真）
r = 2 'rは行？
c = 1 'cは列？
Cells.ClearContents 'セルのコメント値クリア
Do While r <= 101 ' 条件式を満たすまで繰り返す処理
With Cells(r, 1) '同じオブジェクトに対して複数の処理を実行する
.Value = r - 1 'セルの指定方法
.Font.ColorIndex = 5 'フォントの文字色を設定
End With
'6つのランダム数字を振る
For c = 2 To 7
Cells(r, c).Value = Application.WorksheetFunction.RoundUp(Rnd() * 43, 0)
Next c
Set Rng = Range(Cells(r, 2), Cells(r, 7))
Rng.Sort _
key1:=Cells(r, 1), _
Order1:=xlAscending, _
Orientation:=xlLeftToRight
'同じ行に同一数値が無いかの判定
For c = 2 To 5 '★ 5 まで
If Cells(r, c).Value = Cells(r, c + 1).Value Then
Rng.ClearContents
Flg = False
Exit For
End If
Next c
'この数値の６つが今までに出た組み合わせでないか判定
For k = r - 1 To 2 Step -1
i = 1 ' ★ これもフラグ？
For c = 2 To 7
If Cells(r, c).Value <> Cells(k, c).Value Then
' i = i * 0 ' ★？？？
i = 0
End If
Next c
If i = 1 Then
Rng.ClearContents
Flg = False
Exit For
End If
Next k
'両方OKの場合次へ
If Flg = True Then
r = r + 1
ElseIf Flg = False Then
Flg = True
End If
Loop
Set Rng = Nothing
End Sub
EXCEL の機能に重複の削除というのもありますから、そういった機能を使うのも一法だと 思います。 後こういったときによく使うのは Dictionary でしょうか。 この例は後ほど。 （Mook） 2015/01/12(月) 13:00
ちょっと興味本位で作ってしまったので、あまり参考にならないかもしれませんが、 こんな書き方もあるということで。
Dictionary http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html
SortedList http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_sortedlist.html
Option Explicit
Sub LotoSix()
Cells.Clear
Dim lotoDic
Set lotoDic = CreateObject("Scripting.Dictionary")
Dim nums
Dim checkKey As String
Do While lotoDic.Count < 100 ' 登録が100になるまで実行
nums = CreateLoto()
checkKey = Join(nums, "/") ' 数字を 「/」でつなげた文字列を生成
If lotoDic.Exists(checkKey) = False Then ' 同じ数値が無ければ登録
lotoDic(checkKey) = True
Cells(lotoDic.Count, "A") = lotoDic.Count
Cells(lotoDic.Count, "A").Font.ColorIndex = 5
Cells(lotoDic.Count, "B").Resize(1, 6) = nums
End If
Loop
End Sub
Function CreateLoto()
Dim DataList
Set DataList = CreateObject("System.Collections.SortedList")
Dim n As Long
Do While DataList.Count < 6 ' 数字が6個になるまで実行
n = Int(Rnd() * 43) + 1
If DataList.Contains(n) = False Then ' 同じ数字がなければ登録
DataList.Add n, n
End If
Loop
' 結果を Array にして返す。 （VBA では CopyTo が使えないようなので。）
Dim res()
ReDim res(DataList.Count)
Dim r As Long
For r = 0 To DataList.Count - 1
res(r) = DataList.getByIndex(r)
Next
CreateLoto = res
Set DataList = Nothing
End Function
（Mook） 2015/01/12(月) 13:51
wordで直しながら書いていた物をそのままコピーしたのでインデントしてませんでした。
なにせ色々付け刃的な所があるので、Integerで書いたのは、Longよりメモリの無駄な領域を確保しないと何処かのサイトで見かけたものでした。
今、色々調べたら、Integer型は2byte(16bit)領域に格納され、また、Long型は4byte(32bit)領域に格納される事が分かりました。
そのため、16bitのInteger型は、一度32bitに変換してから処理を行うとの事。
結果、PC内部での変換により、32bit領域のLong型の方が処理が早いとの事でしたのでLongを使います。
やはり、誰かに質問すると気がつかない所が見えてきます。
たしかにこのコードで、アクティブなSheet1で動きますが、sheet2でのデータを参照しながら
ループさせたい事でした。
（fairlady） 2015/01/12(月) 15:15
>Integerで書いたのは、Longよりメモリの無駄な領域を確保しないと何処かのサイトで見かけたものでした。 の認識は誤ってはいませんが、CPUが貧弱で、メモリが少なったはるか昔のお話です。 メモリが潤沢にあり、CPU が高速化された現在では、メモリや実行速度（変数の違いによる） はとるに足らないお話だと思います。
それよりは、配列を使うとか、計算をつどしない（Calculation）や画面を更新しない （ScreenUpdating）などを制御する方が何千倍、何万倍も性能に寄与します。
さて、本題ですが、Sheet1とSheet2 の具体的な使い方はどういったモノでしょうか。 Sheet2 のデータというのは何でしょう？ （Mook） 2015/01/12(月) 15:24
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.