VBA:循环不工作,因为它应该

在这里新来的,我不知道我是否可以清楚地陈述我的问题,但我会尽力的。

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

我的问题是,只有当'fam'等于'z'列中的值时,该循环才能工作。 因此,更详细地说,工作表“gbe …”中的D列包含B列中数字的前2个值,当我从键盘input一个存储在“fam”中的值时,代码是应该在整个列中search该值,然后继续从数据库中提取我所要求的数据,但是当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 

看来你并没有在这个循环中更新z或者fam:

 Do While fam = z 

这将导致无限循环。 如果我正确地理解你正在尝试做什么,你应该把它replace

 If fam = z Then 

另外,你可能想testing你的查询是否返回任何值。 像这样的东西:

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