私は現在Excelのデータベース検索アプリケーションを開発中ですが、残念ながらコードを正しく実行することができません。私のプログラムが実行されないようにするエラーは、メインコードの最後に "Loop without do"と表示されます。私はどこにでも追加しようとしましたが、ループを取り除くと、ループエラーなしでdoが返されます。使用するように、など、VBAデータベース検索コード
Sub FindGame()
Worksheets("DATA").Activate
Dim month As Range
Dim database As Range
Dim day As Range
Dim time As Range
Set database = Worksheets("DATA").Range("A4:D42")
Set month = Worksheets("DATA").Range("B4:B42")
Set day = Worksheets("DATA").Range("C4:C42")
Set time = Worksheets("DATA").Range("D4:D42")
i = 1
RowStart = 0
RowEnd = 0
If frmPreference.optDOW.Value = True Then
'sort by Month and then by day of the week
Range(database).Sort Key1:=Range(month), Order1:=xlAscending, key2:=Range(day), order2:=xlAscending
With Range(database)
Do While Cells(i, 1) <> ""
For i = 5 To 42
If Cells(i, 1) = xmonth Then
If day = "Sunday" Then
RowStart = i
Do While Cells(i, 1).Value = xmonth
i = i + 1
Loop
RowEnd = i - 1
Exit Do
ElseIf Cells(i, 2) = day Then
RowStart = i
Do While Cells(i, 1).Value = xmonth
If Cells(i, 2).Value <> day Then
RowEnd = i - 1
Exit Do
End If
i = i + 1
Loop
RowEnd = i - 1
Exit Do
End If
End If
i = i + 1
Loop
If frmPreference.optGameTime.Value = True Then
'sort by month and then by time
Range(database).Sort Key1:=Range(month), Order1:=xlAscending, key2:=Range(time), order2:=xlAscending
Worksheets("DATA").Activate
Do While Cells(i, 1) <> ""
If Cells(i, 1) = xmonth And Cells(i, 3).Value = GTime Then
RowStart = i
Do While Cells(i, 1).Value = xmonth
If Cells(i, 3).Value <> GTime Then
RowEnd = i - 1
Exit Do
End If
i = i + 1
Loop
RowEnd = i - 1
Exit Do
End If
i = i + 1
Loop
Worksheets("Welcome").Activate
Call DisplayProduct
End Sub
** **は動作しません。間違いはありますか? –
問題を再現する必要がないすべてのコードをサンプルから削除してください。 – Leviathan
これは 'MS-Access'の仕事です! Excelのシートをmsアクセスデータベースにリンクさせ、vbaなしでフォームを使用して検索するのは非常に簡単です。 – BitAccesser