VBAのコードエラーの原因を教えていただきたいです。

Question

Sub CreateRotatingRolesAndGroups()

Dim TotalParticipants As Integer

Dim Participants() As String

Dim Roles() As String

Dim Groups() As String

Dim CurrentRound As Integer

Dim GroupSize As Integer

Dim i As Integer, j As Integer

Dim OutputRow As Integer

Dim ws As Worksheet

' グループのサイズと総参加者数を設定

GroupSize = 4 TotalParticipants = 40 ' A組とB組合わせた参加者数

' 役割の配列を作成

Roles = Array("A", "B", "C", "D")

' 参加者の名前を設定

ReDim Participants(1 To TotalParticipants)

For i = 1 To TotalParticipants

Participants(i) = "参加者" & i

Next i ' グループ数を計算

ReDim Groups(1 To TotalParticipants)

For i = 1 To TotalParticipants

Groups(i) = "グループ" & CStr((i - 1) / GroupSize + 1)

Next i

' 新しいワークシートを作成

Set ws = Worksheets.Add

' 各ラウンドでのグループと役割を割り当てる

OutputRow = 1 CurrentRound = 1

Do

If CurrentRound >= 1 And CurrentRound <= 6 Then

' 1回目から６回目は同じ組の中からグループ分け

ShuffleArray Groups

Else

' ７回目はA組、B組から2名ずつをランダムに選択

RandomlySelectFromGroups Groups, 2, "A"

RandomlySelectFromGroups Groups, 2, "B"

End If

' グループと役割をシャッフル

ShuffleArray Groups

ShuffleArray Roles

' グループと役割をワークシートに書き込む

For i = 1 To TotalParticipants

ws.Cells(OutputRow, 1).Value = Participants(i)

ws.Cells(OutputRow, 2).Value = Groups(i)

ws.Cells(OutputRow, 3).Value = Roles(i Mod 4)

OutputRow = OutputRow + 1

Next i

CurrentRound = CurrentRound + 1

Loop Until CurrentRound > 12

' 12回分の割り当てを行う

End Sub

Sub ShuffleArray(ByRef Arr() As String)

Dim Temp As String

Dim i As Long, j As Long

' Fisher-Yates シャッフルアルゴリズムを使用

For i = UBound(Arr) To LBound(Arr) Step -1

j = Int((i - LBound(Arr) + 1) * Rnd + LBound(Arr))

Temp = Arr(i)

Arr(i) = Arr(j)

Arr(j) = Temp

Next i

End Sub

Sub RandomlySelectFromGroups(ByRef Groups() As String, ByVal Count As Integer, ByVal GroupPrefix As String)

Dim i As Integer, j As Integer

Dim GroupIndices() As Integer

Dim AvailableGroupIndices() As Integer

ReDim GroupIndices(1 To UBound(Groups))

ReDim AvailableGroupIndices(1 To UBound(Groups))

' GroupPrefix に一致するグループのインデックスを取得 j = 0

For i = 1 To UBound(Groups)

If Left(Groups(i), Len(GroupPrefix)) = GroupPrefix Then

j = j + 1

GroupIndices(j) = i

End If

Next i

' 利用可能なグループのインデックスを初期化

For i = 1 To UBound(Groups)

AvailableGroupIndices(i) = i

Next i

' GroupIndices からランダムに Count 個のグループを選択

For i = 1 To Count

j = Int((UBound(GroupIndices) - 1 + 1) * Rnd + 1)

Groups(GroupIndices(j)) = "Selected"

GroupIndices(j) = GroupIndices(UBound(GroupIndices))

ReDim Preserve GroupIndices(1 To UBound(GroupIndices) - 1)

Next i

End Sub

このコードで Roles = Array("A", "B", "C", "D")のところで、実行時エラー：13型が一致しませんとエラーメッセージが出ます。どこを修正すればこのVBAが動くのかわかりません。型をStringではなく、Variantにしてもうまく動かず困っています。
どうぞよろしくお願いいたします。

Answer 1

コード全体の問題を「上手く動くようにするにはどうすれば良いでしょう」というような質問はフォーラムでの質問としては相応しくないので、まずはご自身のデバッグ力を向上させた方が良いように思います。

VBAの公式サポート場所は、冒頭で提示してご理解頂けてると思われます。
デバッグ力などを身につけられたら、公式サポートサイトへ質問されるのでは無いでしょうか？

Answer 2

このフォーラムは1つの問題で1つのスレッドが原則なので、

Roles = Array("A", "B", "C", "D")

の部分（Roles 変数の初期化）のエラーが回避したのであれば、このスレッドは解決済みとして、

ShuffleArray Roles

のエラーについては新規で質問しましょう。

というか、コード全体の問題を「上手く動くようにするにはどうすれば良いでしょう」というような質問はフォーラムでの質問としては相応しくないので、まずはご自身のデバッグ力を向上させた方が良いように思います。

Answer 3

いくつか前の返信を見ると Dim Roles As Variant にして最初のエラーはなくなったようですね。

ShuffleArray Rolesのエラーはサブルーチンに渡すパラメータとサブルーチンで定義しているパラメータの型の不一致で生じています。

ShuffleArray Groups

ShuffleArray Roles

Groupsが String型の配列、RolesはValiant型（実際は String型Valiant型の配列が格納されている。）

ShuffleArray で定義している引数は Arr() As String となっているため、Rolesを指定するとエラーになります。（単に型の比較だけなので）

Groups、Roles の両方とも受け取れるようにするには、引数を Arr As Valiant とする必要があります。Valiant型はどんな型でも格納できるため、コンパイルエラーにはなりません。実行時に格納されているデータが配列であれば、配列として扱うことができます。（Roles と同じです。）

もちろん、下記の修正でも問題ありません。

---

Dim Roles() As String　を使うなら

ReDim Roles(3) '配列初期化

Roles(0) = "A"

Roles(1) = "B"

Roles(2) = "C"

Roles(3) = "D"

---

インデックスが有効範囲にありませんについては、GroupIndices(j)の実際の値を確認してください。そして、なぜその値になるかロジックを調べて修正してください。

Answer 4

マクロを教えてくれる有料のＰＣ教室などに通われることを強く推奨します。

（リファレンスマニュアルやネット情報などを読み解けないのであれば、

　リアルで教えてくれる教室をお勧めします。）