こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA A1をA2に変更したい

またお世話になります。
下記のはランダムにチーム分けするものです。
TmCnt = 5がチーム数です。
これはA1から氏名を読み取り、C1からランダムに表を作成するものです。
A2、C2に変更したいのです。
Data1 = Range("A1:A" & Total).Value A1をA2に変えましたが、「インテックスが有効範囲にありません」とエラーメッセージが出ます。
どこが違うのでしょうか?
宜しくお願いします。

Sub Sample()
Dim Total As Integer
Dim TmCnt As Integer
Dim Data1 As Variant
Dim Data2() As String
Dim i As Integer, j As Integer, k As Integer

Total = Cells(Rows.Count, 1).End(xlUp).Row
TmCnt = 5
Data1 = Range("A1:A" & Total).Value
ReDim Data2(1 To Total)
Randomize

For i = TmCnt To 1 Step -1
j = Int(Rnd * i) + 1
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i
For i = Total To TmCnt + 1 Step -1
j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1)
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i

i = 1
Do
For j = 1 To TmCnt
k = k + 1
Cells(i, j + 2).Value = Data2(k)
If k = Total Then Exit Sub
Next j
i = i + 1
Loop
End Sub

投稿日時 - 2019-11-05 16:26:23

QNo.9675263

すぐに回答ほしいです

質問者が選んだベストアンサー

ReDim Data2(1 To Total)
Randomize

が抜けています。
No2を再度確認してください。

投稿日時 - 2019-11-06 10:34:42

お礼

ありがとうございます。
うまくいきました。

投稿日時 - 2019-11-06 13:19:23

ANo.4

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

一部訂正です。

Total = WorksheetFunction.CountA(Range(Cells(FirstRow, 1), Cells(LastRow, 1)))

Total = LastRow - FirstRow + 1
に変更してください。
前者は連続してデータがある場合はいいのですが、途中空白があった場合最後のデータまで右の表に書き込めません。

投稿日時 - 2019-11-05 19:04:18

お礼

ありがとうございます。
以下で動作しましたところ、「インテックスが有効範囲にありません」とエラーメッセージが出ます。どこが違うのでしょうか?
宜しくお願いします。

Sub sample()
Dim Total As Integer
Dim TmCnt As Integer
Dim Data1 As Variant
Dim Data2() As String
Dim i As Integer, j As Integer, k As Integer
Dim FirstRow As Long, LastRow As Long

FirstRow = 2
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Total = LastRow - FirstRow + 1
TmCnt = 5
Data1 = Range(Cells(FirstRow, 1), Cells(LastRow, 1)).Value

For i = TmCnt To 1 Step -1
j = Int(Rnd * i) + 1
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i
For i = Total To TmCnt + 1 Step -1
j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1)
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i

i = 1
Do
For j = 1 To TmCnt
k = k + 1
Cells(i, j + 2).Value = Data2(k)
If k = Total Then Exit Sub
Next j
i = i + 1
Loop
End Sub

投稿日時 - 2019-11-06 09:27:41

ANo.2

以下のようにしてください。

Sub Sample()
Dim Total As Integer
Dim TmCnt As Integer
Dim Data1 As Variant
Dim Data2() As String
Dim i As Integer, j As Integer, k As Integer
Dim FirstRow As Long, LastRow As Long

FirstRow = 2
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Total = WorksheetFunction.CountA(Range(Cells(FirstRow, 1), Cells(LastRow, 1)))
TmCnt = 5
Data1 = Range(Cells(FirstRow, 1), Cells(LastRow, 1)).Value

'↓ここから
'Total = Cells(Rows.Count, 1).End(xlUp).Row
' TmCnt = 5
' Data1 = Range("A1:A" & Total).Value
'↑ここまでを削除もしくはコメントにする

'↓ここから
ReDim Data2(1 To Total)
Randomize
'↑ここまでは元の部分で以下は変更なし

投稿日時 - 2019-11-05 17:54:35

ANo.1

Data1 = Range("A2:" & Total).Value
にしたことによりData1は19個になりました。
For i = Total To TmCnt + 1 Step -1
Totalは20なので
Data1(j, 1) = Data1(i, 1)
i=Totalの時にData1(20, 1)を指定したことになりエラーになっています。

最初の方を以下のようにしてFirstRow で最初の行を指定したほうがいいかもしれせん。
Dim FirstRow As Long, LastRow As Long

FirstRow = 2
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Total = WorksheetFunction.CountA(Range(Cells(FirstRow, 1), Cells(LastRow, 1)))
TmCnt = 5
Data1 = Range(Cells(FirstRow, 1), Cells(LastRow, 1)).Value

投稿日時 - 2019-11-05 17:07:40

お礼

コメントありがとうございます。
すみませんが、最初の方を以下のようにとはどこからどこまででしょうか?

投稿日時 - 2019-11-05 17:38:35

あなたにオススメの質問