Question

在这里新人我不知道我是否可以说清楚我的问题，但我会尝试。

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

我的问题是循环只有在'fam'等于'z'列中的值时才会起作用。因此，更详细地说，工作表“gbe ...”中的D列包含B列中数字的前2个值，当我从键盘输入一个存储在'fam'中的值时，代码是应该在整个列中搜索该值，然后继续从数据库中仅提取我要求的数据，但是当fam＆lt;＆gt;时，循环不会停止ž。

我希望你能帮助我，我从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

VBA：Loop无法正常工作

1 个答案: