VBA インデックスが有効範囲にありません

DBからレコードを取得して配列に入れ込みセルに出力したいです。
何がしたいのかというと、エクセルのシートにタイムテーブルのようなものを作成したいと考えています。DBからテーブル値関数を呼び出しレコードをVBAのFor文でまわして時間のセルに対応するDBの項目に"1"が立っていたら、セルに色を付けるという仕組みにしようと思っています。
DBから値は取得できています。

しかし現在のコードで実行すると、「インデックスが有効範囲にありません」というエラーが出ます。
行と列を入れ替えるとエラーは起きないのですが、、、

VBA
1Sub G_timetable_get(time_val As String)
2
3
4    Dim db As New ADODB.Connection
5    Dim rs As New ADODB.Recordset
6    Dim strSQL As String
7    Dim CON As String
8    Dim t As String
9    
10  
11    CON = "Provider = SQLOLEDB;"
12    CON = CON & "DATABASE=YOYAKU;"
13    CON = CON & "UID=***;"
14    CON = CON & "PWD=***;"
15  
16     
17  
18   
19      strSQL = "Select isnull(t1,'') As t1,isnull(t2,'') As t2,isnull(t3,'') As t3,isnull(t4,'') As t4,isnull(t5,'') As t5,isnull(t6,'') As t6,isnull(t7,'') As t7,isnull(t8,'') As t8,isnull(t9,'') As t9,isnull(t10,'') As t10,isnull(t11,'') As t11 from dbo.timetable_get(" & " ' " & t & " ' " & ",'" & time_val & " ' " & ") "
20      
21      Set rs = New ADODB.Recordset
22      
23      rs.Open strSQL, CON
24      
25      rs.MoveFirst
26      
27      Dim i As Long, j As Long, hairetsu As Variant
28      hairetsu = rs.GetRows
29      
30      For i = 0 To UBound(hairetsu, 1)  
31        For j = 0 To UBound(hairetsu, 2) 
32            If hairetsu(j, i) = "1" Then
33            Sheet5.Cells(j + 5, i + 4).Interior.Color = RGB(255, 0, 0)
34            End If
35            
36        Next
37    
38      Next
39      
40      rs.Close
41      
42
43     Set rs = Nothing
44     Exit Sub
45
46
47
48End Sub
49
50

コード修正後にはタイムテーブルのようなものを作ることができました。

行動規範の内容に同意します

回答2件

ベストアンサー

hairetsuの参照方法が間違っていると思われます。

UBoundの説明
https://msdn.microsoft.com/ja-jp/library/cc392345.aspx

GetRowsの説明
https://msdn.microsoft.com/ja-jp/library/cc364163.aspx

UBound(hairetsu, 1)とした場合は、hairetsuの１つ目の要素の数、
UBound(hairetsu, 2)とした場合は、hairetsuの２つ目の要素の数、
を表します。
つまり、hairetsu(i, j)にならないといけないところが、hairetsu(j, i)になっているのが問題と思われます。

余談ですが、変数名iやjでは、行なのか列なのか判別しづらいので、rowやcol（予約語なので別の類似の名前にする必要はありますが）、もしくはyやxなど、わかりやすいものにしたほうがよいです。

VBA
1' r=row c=column
2For r = 0 To UBound(hairetsu, 2)  
3	For c = 0 To UBound(hairetsu, 1) 
4		If hairetsu(c, r) = "1" Then
5			Sheet5.Cells(r + 5, c + 4).Interior.Color = RGB(255, 0, 0)
6		End If
7	Next
8Next
9

投稿2018/09/21 00:09

ttyp03

総合スコア16998

rikaruto

2018/09/21 07:22

回答ありがとうございます。ttyp03さんのおっしゃる通り逆になっていました。コードを修正したところ、シートに色を付けることができました。ご協力に感謝いたします。前回もありがとうございます！

行動規範の内容に同意します

少し文からプログラム内容が読み取りづらいので純粋にレコードを回してフィールドを回しては？
行番号はrs.AbsolutePositionで、列番号はmid(fld.name,2)で取得できそうですので、
個人的にはですがプログラムが見やすいのでこのようにすると思います。

ちなみにADODB.Connectionオブジェクトは一切使っていませんので不要かと^^;

vba
1      Set rs = New ADODB.Recordset
2
3      rs.Open strSQL, CON
4
5      rs.MoveFirst
6
7    Dim fld As ADODB.Field
8    
9    With rs
10        If Not (.EOF) Then
11            Do Until (.EOF)
12                For Each fld In .Fields
13                    Debug.Print fld.Name, fld.Value, .AbsolutePosition, Mid(fld.Name, 2)
14                Next
15                .MoveNext
16            Loop
17        End If
18    End With