エクセルでのアクセスからのデータ抽出

質問

Web情報を参考にエクセルにて下記VBAコードを作りました。

Sub DB_Read()
Dim adoCON As New ADODB.Connection
Dim adoRS As New ADODB.Recordset
Dim strSQL As String
Dim odbdDB As Variant
Dim wSheetName As Variant
Dim i, j As Integer
Dim GetName

odbdDB = ActiveWorkbook.Path & "\test.accdb"

adoCON.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & odbdDB & ""
adoCON.Open

j = 4
Do Until j = 18

GetName = Range("B4").Value & "_" & Cells(16, j).Value

strSQL = "SELECT 規格値,Max,Min,結果1,結果2,結果3 FROM T_測定結果 WHERE [測定項目]='" & GetName & "'"
adoRS.Open strSQL, adoCON, adOpenDynamic
wSheetName = ActiveSheet.Name

i = 20

adoRS.MoveLast
Do Until adoRS.EOF Or i = 25
With Worksheets(wSheetName)
.Cells(17, j).Value = adoRS!規格値
.Cells(18, j).Value = adoRS!Max
.Cells(19, j).Value = adoRS!Min
.Cells(i, j).Value = adoRS!結果1
.Cells(i + 10, j).Value = adoRS!結果2
.Cells(i + 20, j).Value = adoRS!結果3
End With
i = i + 1
adoRS.MovePrevious
Loop
j = j + 1
Loop

adoRS.Close
Set adoRS = Nothing
adoCON.Close
Set adoCON = Nothing

End Sub

VBAを走らせると1巡は走るのですが、「Do Until j = 18」の2巡目に入ると、「wSheetName = ActiveSheet.Name」のところで「実行時エラー3705　アプリケーション定義またはオブジェクトの定義エラー」と出てしまいます。
エラーの原因が分からないので、アドバイスを頂きたいです。

回答No.8

kkkkkm · ベストアンサー

> B4の値によっては①～⑦や、①～⑩まで等、⑮に満たない時もあります

その時の値が何で(その値によってどこの何が変化するのか)それで①～⑦や、①～⑩とかをどの値で決めているのかが分からないだろうといってるのですが、そんなこともいちいち細かく言わなければ説明できないなら自分で考えてください。

回答No.7

kkkkkm

> Range("B4").Valueに入る値が変わると、
> 取得するデータ数が変化します。

この状態をどのようにして実装しているのか不明。
この部分を説明せずに以下を聞くのはムチャぶりというもの。

> Forの値が17以下だった場合でもエラーが出ずに処理できるようになればいいのですが。

16行に、Vlookupで値を表示、一致が無ければ""みたいな式など何らかの式が入っていなければ

Dim LastColumn As Long

LastColumn = Cells(16, Columns.Count).End(xlToLeft).Column
For j = 4 To LastColumn

実際の操作

Next

式が入っている場合、不要なセルにデータの表示が無い""の場合

For j = 4 To 17
If Cells(16, j).Value = "" Then
Exit For
End If

実際の操作

Next

補足

ご提示頂いた内容を試したのですが、ご指摘の通り私の説明が悪く、違う回答を求めてしまったようです。大変申し訳ありません。

D16：R16までは予め①～⑮までの値が入力してあり、B4の値と組み合わせ、1巡目の処理ではtest_①と一致するものを抽出、
2巡目ではtest_②と一致するものを抽出と、①～⑮までを1つづつ変えながら繰り返し抽出を行いたいのですが、
B4の値によっては①～⑦や、①～⑩まで等、⑮に満たない時もあります。
今は⑮まで満たない場合は、エラーで停止してしまうので、
⑮まで満たない場合でもエラーが出ないで停止するようにしたいのです。

上手く説明することができず、ご迷惑をお掛けしてしまっておりますが、ご教示をお願いします。

回答No.6

kkkkkm

Cells(16, j).Value
ですから
jはシートの列指定の変数だと思いますが。

For J = 4 to 10
で正常なら
D16からJ16までしかデータが無かったという事じゃないですか。

補足

>For J = 4 to 10
>で正常なら
>D16からJ16までしかデータが無かったという事じゃないですか。
今回確認したパターンでは、D16からJ16までしかデータない状態なのですが、
「GetName = Range("B4").Value & "_" & Cells(16, j).Value」のRange("B4").Valueに入る値が変わると、
取得するデータ数が変化します。
当初より提示させて頂いたFor J = 4 to 17というのは取得データ数の最大数なので、
もしForの値が17以下だった場合でもエラーが出ずに処理できるようになればいいのですが。

回答No.5

kkkkkm

> ＞とりあえずActiveSheet.Nameを実際のシート名にして
> →どちらも　wSheetName = ActiveSheet.Name　でstop

ActiveSheet.Nameを実際のシート名にしたら
wSheetName = ActiveSheet.Name
というコードはありえませんが…。

> →どちらも　i = 20の前でstop

前って…なにもコードの無いところでは止まらないと思いますが…。

きちんと状況を説明できないみたいですね。回答した手順もちゃんと実行できていなのではないでしょうか。

adoRS.Closeを

略
adoRS.MovePrevious
Loop
j = j + 1
adoRS.Close '←ここに入れましたか？
Loop
略

補足

＞adoRS.Closeを
＞略
＞adoRS.MovePrevious
＞Loop
＞j = j + 1
＞adoRS.Close '←ここに入れましたか？
＞Loop

アドバイス通りに入れたら、2巡目以降も動きました。
自分は下記のように訂正していました。
　adoRS.MovePrevious
　Loop
　j = j + 1
　adoRS.Close
Set adoRS = Nothing
adoCON.Close
Set adoCON = Nothing
　Loop
アドバイスの意味を間違えて捉えていたので、見当違いの回答になってしまい大変失礼しました。
ですが、希望通りに動くようになりました。ありがとうございます。

ただ１つ、For J = 4 to 17 が完了する前にテーブルから抽出できるデータが無くなってしまうと、
「3021　アプリケーション定義またはオブジェクト定義エラー」
と出てしまいます。
仮にFor J = 4 to 10 としたらエラーが出ずに処理が完了しました。

Forの回数をレコードの数によって変化させるということはできますでしょうか。
お手数ですが、こちらもご教示頂きたいです。

回答No.4

kkkkkm

> どのパターンも同じところで同じエラーが発生してしまいます。

wSheetName = ActiveSheet.Name
を無くしたパターンでは同じところはないはずですが。
wSheetName = ActiveSheet.Name
がありませんから同じところでエラーになるとはどういうことでしょう。

また
Do Until j = 18の前に置いても
その前の
wSheetName = ActiveSheet.Name
でエラーなのですか？
としたら一回も実行されないということになります。

とりあえずActiveSheet.Nameを実際のシート名にして試してみてください。

回答No.3

kkkkkm

No2の訂正です。

For j = 4 To 18
は
For j = 4 To 17

補足

ご回答ありがとうございます。
ご回答頂いた内容に変更し確認してみましたが、どのパターンも同じところで同じエラーが発生してしまいます。

回答No.2

kkkkkm

No1の蛇足です。

本題とは関係ありませんが

j = 4
Do Until j = 18
：
j = j + 1
Loop

は

For j = 4 To 18
:
Next

で良さそうな気がします。

回答No.1

kkkkkm

adoRS.Open strSQL, adoCON, adOpenDynamic
がCloseしないままに再度実行されますが
adoRS.Closeを
j = j + 1
の後の
Loop
の前に置いた方がいいような気もします。

あと

wSheetName = ActiveSheet.Name
を
Do Until j = 18
の前に置くとか

wSheetName = ActiveSheet.Name
をやめて

With Worksheets(wSheetName)
を
With ActiveSheet
にしてみてはいかがでしょう。

補足

アドバイス頂いた内容のエラーを再度確認しました
>adoRS.Closeを
>j = j + 1
>の後の
>Loop
>の前に置いた方がいいような気もします。

＞とりあえずActiveSheet.Nameを実際のシート名にして
→どちらも　wSheetName = ActiveSheet.Name　でstop

＞wSheetName = ActiveSheet.Name
＞を
＞Do Until j = 18
＞の前に置くとか

＞wSheetName = ActiveSheet.Name
＞をやめて
＞With Worksheets(wSheetName)
＞を
＞With ActiveSheet

→どちらも　i = 20の前でstop

どちらも同じ箇所と伝えていましたが、改めて確認したところ、違っておりました。大変失礼しました。