Results of 1 - 1 of about 1215 for （Mook）
(0.001 sec.)
- [[20150112095914]]
- #score: 9211
- @digest: 91063505111ddcf7b38d40cb590017b5
- @id: 67006
- @mdate: 2015-01-12T06:25:03Z
- @size: 8717
- @type: text/plain
- #keywords: lotodic (65413), datalist (46405), checkkey (29993), createloto (22494), 法. (11543), 定fo (8437), sortedlist (5092), flg (2875), integer (2809), ダム (2392), モリ (2248), 整数 (2064), 格納 (1782), 領域 (1745), ラグ (1673), メモ (1637), フラ (1564), cells (1524), ンダ (1485), ラン (1473), clearcontents (1431), 定方 (1211), dictionary (1154), 判定 (1117), rng (1070), colorindex (954), 数字 (932), 過去 (798), サイ (790), 変数 (784), 重複 (760), long (723)
- 『ExcelVBAで重複データを調べランダムに数字を作成』（fairlady）
こちらのサイトはよく参考にしており、今回初の投稿になります。宜しくお願いいたします。 仕事でもExcelをよく使っていますが、まだまだスキルが足りないと思い、独学で学んでおります。 それにあたり、何かよい題材がないかと思い、たまに買う数字選択宝くじを思い浮かべ 自分で色々表を作成して、多少関数など使えるようになったのですが、如何せん 手作業では、沢山できた表を管理出来なくなってきました。そこで今まで敷居が高く、 避けてきたVBAを学ぼうと思い色々なサイトを探して、こんなコードをみつけて、 Excelで数字をランダムに作成し、自分で作った表の過去データと重複していないか 確認しようと思ったのですが、うまくコードが書けません。 沢山のサイトを調べたのですが、いきずまっての投稿になります。 そこで今回の質問内容ですが、 1 Sheet1で数字を6個ランダムに100通り組合せを作る 2 Sheet2に過去のデータをB2〜G2以下に毎回入れる ※ 1での作成時に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 'この数値の6つが今までに出た組み合わせでないか判定 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 'この数値の6つが今までに出た組み合わせでないか判定 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... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201501/20150112095914.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97057 documents and 608292 words.
訪問者：