ここから本文です

エクセル VBA について質問します。 Declare Sub Sleep Lib "kernel32" (ByVal ...

met********さん

2016/10/3013:02:29

エクセル VBA について質問します。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Test()
Dim i As Long
Dim buf(1 To 10) As Boolean
Range("

A1:A10").Clear
For i = 1 To 10

Do
cnt = Int(Rnd * 10) + 1
Loop Until buf(cnt) = False
Range("A" & cnt).Interior.ColorIndex = 6
buf(cnt) = True
Sleep 1000
DoEvents
Next i
End Sub

これに
Dim j As Long
Dim buf1(1 To 10) As Boolean
を付け足して

A列の次にB列の処理が出来る
様にしたのですが

A列とB列を同時に処理するには
どうすればいいのでしょうか?

お願いします。

閲覧数:
121
回答数:
3
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

kik********さん

2016/10/3014:38:38

以下でどうなりますか

> A列の次にB列の処理
Samp1 ~ Samp3 がその処理になります

> A列とB列を同時に処理
Samp4 がその処理になります(Samp3 の改造版)

Samp1

A列の次にB列 を処理する時には、
> Dim buf1(1 To 10) As Boolean
を追加するのではなく、
Dim buf() As Boolean
を初期化して使いまわせば良いですね・・・

>            Do
>               cnt = Int(Rnd * 10) + 1
>            Loop Until buf(cnt) = False

この部分、最悪無限ループになったり?

1 ~ 10 を重複なく抽出できれば良いので
Samp2 は配列を使って
Samp3 は Dictionary を使って

Samp2

iA(1) ~ iA(10) に iA(1) = 1、・・・ iA(10) = 10 を入れておいて
配列最後の添え字を n に
k = Int(n * Rnd()) + 1
として配列添え字を得ます
iA(k) の行に色を付け、iA(k) に 配列最後 iA(n) を設定します
n = 10 で k = 4 なら
iA(1) = 1
iA(2) = 2
iA(3) = 3
iA(4) = 4
iA(5) = 5
・・・
iA(4) の行の所に色を付けて
iA(4) = iA(10) と iA(4) の内容が選ばれないようにして
iA(1) = 1
iA(2) = 2
iA(3) = 3
iA(4) = 10
iA(5) = 5
・・・
次の k = Int(n * Rnd()) + 1 で選ぶ範囲を狭めておきます
n = n - 1
また k = 4 が得られたら iA(4) = 10 なので、10 行目に色を
で、iA(4) = iA(9) して n = n -1 ・・・・
これで、試行回数少なく違う行が選ばれるようになります

Samp3

Dictionary を使って、1 ~ 10 を入れておきます
そこから1つ取り出し、取り出したものを削除します
取り出したものを行として色付けします
取り出すものがなくなるまで繰り返します

Samp4

指定した範囲のセル個数分 1 ~ Dictionary に作り込みます
そこから1つ取り出し、取り出したものを削除します
取り出したもので色付けします
取り出すものがなくなるまで繰り返します

Samp3 との違いは、色を付ける時のセル指定
Samp3 では、.Cells(v, j).・・・
Samp4 では、.Cells(v).・・・
.Cells(v, j).・・・は、v行 j列の
.Cells(v).・・・は、v個目



Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub Samp1()
   Dim i As Long, j As Long
   Dim cnt As Long
   Dim buf() As Boolean

   Randomize

   With Range("A1:B10")
      .Clear
      For j = 1 To .Columns.Count
         ReDim buf(.Rows.Count)
         For i = 1 To .Rows.Count
            Do
               cnt = Int(Rnd * 10) + 1
            Loop Until buf(cnt) = False
            .Cells(cnt, j).Interior.ColorIndex = 6
            buf(cnt) = True
            Sleep 300
            DoEvents
         Next
      Next
   End With
End Sub


Public Sub Samp2()
   Dim iA() As Long
   Dim i As Long, j As Long, k As Long, n As Long

   Randomize

   With Range("A1:B10")
      .Clear
      ReDim iA(1 To .Rows.Count)
      For j = 1 To .Columns.Count
         For i = 1 To .Rows.Count
            iA(i) = i
         Next
         n = .Rows.Count
         For i = 1 To n
            k = Int(n * Rnd()) + 1
            .Cells(iA(k), j).Interior.ColorIndex = 6
            iA(k) = iA(n)
            n = n - 1
            Sleep 300
            DoEvents
         Next
      Next
   End With
End Sub


Public Sub Samp3()
   Dim dic As Object
   Dim i As Long, j As Long
   Dim v As Variant

   Randomize
   Set dic = CreateObject("Scripting.Dictionary")

   With Range("A1:B10")
      .Clear
      For j = 1 To .Columns.Count
         For i = 1 To .Rows.Count
            dic(i) = Empty
         Next
         While (dic.Count > 0)
            v = dic.Keys()(Int(dic.Count * Rnd()))
            dic.Remove v
            .Cells(v, j).Interior.ColorIndex = 6
            Sleep 300
            DoEvents
         Wend
      Next
   End With
   Set dic = Nothing
End Sub


Public Sub Samp4()
   Dim dic As Object
   Dim i As Long
   Dim v As Variant

   Randomize
   Set dic = CreateObject("Scripting.Dictionary")

   With Range("A1:B10")
      .Clear
      For i = 1 To .Count
         dic(i) = Empty
      Next
      While (dic.Count > 0)
         v = dic.Keys()(Int(dic.Count * Rnd()))
         dic.Remove v
         .Cells(v).Interior.ColorIndex = 6
         Sleep 300
         DoEvents
      Wend
   End With
   Set dic = Nothing
End Sub

  • kik********さん

    2016/10/3017:18:18

    そうそう

    Samp1 ~ 全部

    > With Range("A1:B10")

    ここで指定する範囲を変更すれば、
    変更したなりに動きます


    蛇足)

    > Dim buf(1 To 10) As Boolean ' ★
    >
    > Range("A1:A10").Clear ' ★
    > For i = 1 To 10 ' ★
    >    Do
    >       cnt = Int(Rnd * 10) + 1 ' ★

    上記は、A1:A10 の 10 行の処理記述ですが
    A1:A20 に変更したい・・・・
    ★ の 10 を 20 に変更する必要がありますね?

    全部を、間違いなく、変更出来れば良いのですが・・・
    その時には、変更する部分を局所化します

    10 というのを使いたいのなら、例えば

    Const CRH As Long = 10
    Dim buf(1 To CRH) As Boolean

    Range("A1").Resize(CRH).Clear
    For i = 1 To CRH
       Do
          cnt = Int(Rnd * CRH) + 1

    みたいに、
    Const CRH As Long = 10

    Const CRH As Long = 20
    だけで動くように記述しておきます

  • その他の返信(5件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2016/11/3 00:10:09

samp を参考にして学びます。
ありがとうございます。

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

som********さん

2016/10/3013:45:02

こういうことでしょうか。

Sub test2()
Dim r As Range, cnt As Integer, i As Integer
Dim buf(1 To 20) As Boolean
With Range("A1:B10")
.Clear
For i = 1 To 20
Do
cnt = Int(Rnd * 20) + 1
Loop Until buf(cnt) = False
.Item(cnt).Interior.ColorIndex = 6
buf(cnt) = True
Sleep 1000
DoEvents
Next i
End With
End Sub

30でも40でも、考え方は同じです。

プロフィール画像

カテゴリマスター

nag********さん

2016/10/3016:10:30

下記のコードでいかがでしょうか?

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Sample()
Dim i As Long, j As Long, cnt As Long
Dim buf(1 To 10, 1 To 2) As Boolean 'セル範囲と同じサイズの配列にする
Dim r1 As Long, c1 As Long, r2 As Long, c2 As Long
r1 = LBound(buf, 1) 'セルの開始行
c1 = LBound(buf, 2) 'セルの開始列
r2 = UBound(buf, 1) 'セルの終了行
c2 = UBound(buf, 2) 'セルの終了列

'A1:B10を一旦クリアする
Range(Cells(r1, c1), Cells(r2, c2)).Clear

'乱数の発生パターンを変更する
Randomize Timer

'配列で用意した回繰り返す
For i = r1 To r2
For j = c1 To c2

'まだ色を変えていないセルを探す
Do
cnt = Int(Rnd * (r2 - r1 + 1)) + r1
DoEvents
Loop Until buf(cnt, j) = False

'セルの色を変えて変更済みにする

Cells(cnt, j).Interior.Color = vbYellow
buf(cnt, j) = True

Next j

'1秒待つ
Sleep 1000
DoEvents

Next i

End Sub




①Option Explicitを追加して変数の宣言を強制するようにしました。
これにより、スペルミスによる潜在バグの可能性を排除しました。

②考え方を少し変えてbufを二次元配列にしました。
セル範囲と同じ行・列の配列にすることで対象セル範囲を変更する際のプログラムの変更が最小限になります。

③Randomize関数を使って乱数の発生パターンを変更するようにしました。

④繰り返しの回数をbufの配列数で指定するようにしました。
これにより、
Do
cnt = Int(Rnd * 10) + 1
Loop Until buf(cnt, j) = False
が無限ループになる可能性を排除しました。

⑤色の指定をColorIndexプロパティではなくColorプロパティに変更しました。


ちなみに
Dim buf(1 To 10, 1 To 2) As Boolean

Dim buf(3 To 15, 4 To 6) As Boolean
とするだけでD3:F15の範囲に変更することが出来ます。

下記のコードでいかがでしょうか?

Option Explicit
Declare Sub Sleep...

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる