1

作为新来的,我不知道我是否可以很清楚地说明我的问题,但我会尝试的。

我有这个 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
4

1 回答 1

2

您似乎没有在此循环中更新 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
于 2013-08-08T08:06:46.640 回答