VBA: Loop не работает должным образом

Question

Будучи новым здесь, я не знаю, могу ли я сформулировать свой вопрос на самом деле, но я попробую.

У меня есть код VBA, который извлекает определенную информацию из базы данных доступа в лист Excel по отношению к другому листу Excel. И, будучи новичком в vba-кодировании, я не знаю, насколько хорош или правильный метод, который я использую.

Моя проблема связана с циклом, который должен работать только тогда, когда «fam» равен «z» значение в столбце. Таким образом, более подробно столбец D из рабочего листа «gbe ...» содержит первые 2 значения чисел из столбца B, и когда я даю ввод с моей клавиатуры значение, которое хранится в «fam», код должен искать во всем столбце для этого значения, а затем продолжать извлекать из базы данных только те данные, которые я запрашиваю, но цикл не останавливается, когда fam <> z.

Я надеюсь, что вы можете мне помочь, все, что я узнал о vba, отсюда, но теперь у меня кончились идеи.

Sub Dateinitiale() 
Dim data As Date 
'Dim codprodus, codrola As Variant 
Dim i, j, k, m, n, s, x, y, z2, z3 As Integer 
Dim z As Variant 
Dim olddb As Database, OldWs As Workspace 
Set OldWs = DBEngine.Workspaces(0) 
Set olddb = OldWs.OpenDatabase("C:\BusData\rfyt\xxg\_lgi\data\FyTMaes.Mdb") 'cale BD pentru importul datelor 

Cells(1, 1) = "Cod Produs" 
Cells(1, 2) = "Nr Rola" 
Cells(1, 3) = "Masina " 
Cells(1, 4) = "Data inceput" 
Cells(1, 5) = "Data sfarsit" 

fam = Application.InputBox("Introduceti Familia CAB", "FamCAB Search") 
If fam = False Then Exit Sub 
z = Worksheets("gbe03407e").Cells(2, 4).Value 

x = 2 
y = 2 
z2 = 2 

Do Until z = "" 
z = Worksheets("gbe03407e").Cells(z2, 4).Value 
z3 = z2 
Do While fam = z 

     codrola = Worksheets("gbe03407e").Cells(z3, 2).Value 

     Cells(y, 2).Value = codrola 
     Cells(y, 1).Value = codprodus 
' write the values read from the menu into cells 

     Sql = "select initra, fintra, codmaq, codsuc from tblTRAZA where numser like '" & codrola & "' and (TIPTRA='F' or TIPTRA='FA' or TIPTRA='FD' or TIPTRA='FF' or TIPTRA='FM' or TIPTRA='FT' or TIPTRA='FC' or TIPTRA='FK' or TIPTRA='FN' or TIPTRA='FQ' or TIPTRA='FR')order by fecmov" 
     Set rs = olddb.OpenRecordset(Sql) 
     On Error Resume Next 
     rs.MoveFirst 
     Do Until rs.EOF 
     Cells(y, 1).Value = rs("codsuc") 
     Cells(y, 3).Value = rs("codmaq") 
     Cells(y, 4).Value = rs("initra") 
     Cells(y, 5).Value = rs("fintra") 
     rs.MoveNext 
     Loop 

     x = x + 1 
     y = y + 8 
     z3 = z3 + 1 
Loop 
z2 = z2 + 1 
Loop 
end sub 

Answer 1

Кажется, вы не обновляя либо г или FAM внутри этого цикла:

Do While fam = z 

что привело бы к бесконечному циклу. Если я правильно понял, что вы пытаетесь сделать, вы должны заменить его

If fam = z Then 

Кроме того, вы, вероятно, хотите, чтобы проверить, если ваш запрос возвращает какое-либо значение. Что-то вроде этого:

If fam = z Then 
    ... 
    Set rs = olddb.OpenRecordset(Sql) 
    If Not rs.EoF Then 
     ... 
    End If 
    ... 
End If