Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


24297 / 76732 ←次へ | 前へ→

【57785】オブジェクトの定義エラーになってしまいます。
質問  jeanjean  - 08/9/13(土) 12:19 -

引用なし
パスワード
   Excelで作っている当番表を改定しようと思っています。
シート1に当番表、シート2に名簿があります。

シート1には、毎週末(土・日)の午前・午後の4つ枠があります。それぞれ当番は4人づつです。
シート2には、名前と当番に入れる時間帯のセルがあり、可能な時間帯に○が記入されています。


シート1の該当箇所に、シート2の名簿の中から条件に合う人をランダムに入力させたいと思っています。
名簿に入っている人数は200〜300人ですが、一通り1回づつ回ってから、2順目にいくようにしたいと思っています。

現在作成中のコードは下記のとおりですが、
ReDim Preserve のところの、

strOkMember(lngOkCount) = rngTimeColumn.Offset(j, (i + 1) * (-1)).Value

がエラーになってしまいます。
初心者なもので、なぜエラーになるのかわかりません。
説明が下手でわかりにくいと思いますが、
どうかご教示いただけますでしょうか?よろしくお願いいたしますm(__)m

''////////////////////////////////////////////////////////////
Sub PickUpTest()

Const SHEET_ONE As String = "当番表"
Const SHEET_TWO As String = "名簿"
Const FIELD_B As Integer = 2
Const FIELD_C As Integer = 3
Const INTER_CHAR As String = "・" '
Const OK_VALUE As String = "○"
Const TIME_BOX As Integer = 3
Const SELECT_MEMBER As Integer = 4
Dim strTimeArray(TIME_BOX) As String
Dim i As Long, j As Long


Randomize

For i = 0 To TIME_BOX
With Worksheets(SHEET_ONE)
strTimeArray(i) = _
.Cells(i + 1, FIELD_B) & INTER_CHAR & .Cells(i + 1, FIELD_C)
End With
Next


With Worksheets(SHEET_TWO)
Dim lngCheckRows As Long
lngCheckRows = .UsedRange.Rows.Count - 1

For i = 0 To TIME_BOX

Dim rngTimeColumn As Range
Dim strFirstFind As String
Dim strOkMember() As String
Dim lngOkCount As Long
Dim strSelectMember(SELECT_MEMBER - 1) As String
Dim lngUsedNumber(SELECT_MEMBER - 1) As Long
Dim lngRandNum As Long
Dim lngSelectCount As Long
Dim lngUsedCheck As Long

Set rngTimeColumn = _
.Range("1:1").Find(what:=strTimeArray(i), lookat:=xlWhole)
If Not rngTimeColumn Is Nothing Then

strFirstFind = rngTimeColumn.Address


lngOkCount = 0
For j = 1 To lngCheckRows
If rngTimeColumn.Offset(j, 0).Value = OK_VALUE Then

ReDim Preserve strOkMember(lngOkCount)
strOkMember(lngOkCount) = rngTimeColumn.Offset(j, (i + 1) * (-1)).Value
lngOkCount = lngOkCount + 1
End If
Next


If lngOkCount = 0 Then
ReDim strOkMember(0)
strOkMember(0) = "【みんなダメ!】"
End If

If UBound(strOkMember) < SELECT_MEMBER Then
For j = 0 To UBound(strOkMember)
Worksheets(SHEET_ONE).Cells(i + 1, FIELD_C + j + 1) = strOkMember(j)
Next
Else
lngSelectCount = 0
Do
lngRandNum = CLng(Int(Rnd() * lngOkCount))
If lngSelectCount = 0 Then
strSelectMember(lngSelectCount) = strOkMember(lngRandNum)
lngUsedNumber(lngSelectCount) = lngRandNum
lngSelectCount = 1
Else
lngUsedCheck = 1
For j = 0 To UBound(lngUsedNumber)
lngUsedCheck = lngUsedCheck * (lngRandNum - lngUsedNumber(j))
Next
If lngUsedCheck <> 0 Then
strSelectMember(lngSelectCount) = strOkMember(lngRandNum)
lngUsedNumber(lngSelectCount) = lngRandNum
lngSelectCount = lngSelectCount + 1
End If
End If
Loop Until lngSelectCount = SELECT_MEMBER
For j = 0 To UBound(strSelectMember)
Worksheets(SHEET_ONE).Cells(i + 1, FIELD_C + j + 1) = strSelectMember(j)
Next
End If

End If

Next

End With

End Sub
0 hits

【57785】オブジェクトの定義エラーになってしまいます。 jeanjean 08/9/13(土) 12:19 質問
【57788】Re:オブジェクトの定義エラーになってしま... かみちゃん 08/9/13(土) 12:51 発言
【57791】Re:オブジェクトの定義エラーになってしま... jeanjean 08/9/13(土) 13:24 お礼
【57792】Re:オブジェクトの定義エラーになってしま... かみちゃん 08/9/13(土) 13:34 発言
【57796】Re:オブジェクトの定義エラーになってしま... kanabun 08/9/13(土) 15:34 発言

24297 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free