VBA：循环无法正常工作

Question

作为新手，我不知道我是否能把我的问题说得很清楚，但我会试试的。

我有这个 VBA 代码，它从访问数据库中提取某些信息到与另一个 Excel 工作表相关的 Excel 工作表中。作为 vba 编码的新手，我不知道我使用的方法有多好或正确。

我的问题是只有当“fam”等于“z”列中的值时才应该工作的循环。因此，更详细地说，工作表“gbe ...”中的 D 列包含 B 列中数字的前 2 个值，当我从键盘输入一个存储在“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

您似乎没有在此循环中更新 z 或 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