奇怪的 Excel 格式

Question

最近，我们公司雇用了一个新的合作社，并负责编写一份报告。该报告查询数据库并返回结果集，然后继续创建电子表格。根据所选的天数，会生成不同数量的报告，但我认为这与问题无关。基本上，它会运行报告并循环遍历结果集，但在某些时候会继续循环，直到 65536 处停止。例如，如果结果集包含 74 条记录，则前 74 行将正常显示（格式为黄色），而之后的所有内容也将格式为黄色，尽管应将其单独保留。我继承了这个代码，因为我是一个新的合作社。显然，这只发生在“警卫换岗”时（新合作社必须运行报告）。`

DoCmd.SetWarnings False
DoCmd.OpenQuery ("DailySummaryQueryMain")
strSQL = "SELECT * FROM DailySummaryMain"
Set rs = CurrentDb.OpenRecordset(strSQL)
DoCmd.Echo True, "Running first Report"
If Not rs.EOF Then
    rs.MoveFirst

Do While Not rs.EOF And Not rs.BOF
    xlapp.Range("A" & i).Value = rs.Fields(0).Value    
    xlapp.Range("B" & i).Value = rs.Fields(1).Value    
    xlapp.Range("C" & i).Value = rs.Fields(2).Value     


    Set rs2 = CurrentDb.OpenRecordset("SELECT dbo_StatusType.StatusTypeID, dbo_StatusType.Name FROM dbo_StatusType WHERE (((dbo_StatusType.StatusTypeID)=" & rs.Fields(3) & "))")
    rs2.MoveFirst

    xlapp.Range("D" & i).Value = rs2.Fields(1).Value    
    xlapp.Range("E" & i).Value = rs.Fields(4).Value     
    xlapp.Range("F" & i).Value = rs.Fields(5).Value     
    xlapp.Range("G" & i).Value = rs.Fields(6).Value     

    'count number of outages that start and end on same day
    If Format(xlapp.Range("F" & i).Value, "mm/dd/yyyy") = Format(xlapp.Range("G" & i).Value, "mm/dd/yyyy") Then
        dayCount = dayCount + 1
    End If

    xlapp.Range("H" & i).Value = rs.Fields(7).Value    
    xlapp.Range("I" & i).Value = rs.Fields(8).Value     
    xlapp.Range("J" & i).Value = rs.Fields(9).Value     
    xlapp.Range("K" & i).Value = rs.Fields(10).Value    
    xlapp.Range("L" & i).Value = rs.Fields(11).Value    
    xlapp.Range("M" & i).Value = rs.Fields(12).Value    
    xlapp.Range("N" & i).Value = rs.Fields(13).Value    



    'highlite recently modified rows
    If rs.Fields(14).Value = "Yes" Then
        xlapp.Range("A" & i & ":N" & i).Select
        With xlapp.Selection.Interior
            .ColorIndex = 36
            .Pattern = xlSolid
        End With
    End If

    'break apart by sector
    If CInt(rs.Fields(2).Value) = 1 Then
        row = row1
    ElseIf CInt(rs.Fields(2).Value) = 2 Then
        row = row2
    ElseIf CInt(rs.Fields(2).Value) = 3 Then
        row = row3
    Else
        row = row4
    End If




    xlapp.Worksheets(CInt(rs.Fields(2).Value) + 1).Activate
    xlapp.Range("A" & row).Value = rs.Fields(0).Value     
    xlapp.Range("B" & row).Value = rs.Fields(1).Value     
    xlapp.Range("C" & row).Value = rs.Fields(13).Value   
    xlapp.Range("D" & row).Value = rs.Fields(4).Value    
    xlapp.Range("E" & row).Value = rs.Fields(5).Value     
    xlapp.Range("F" & row).Value = rs.Fields(6).Value     
    xlapp.Range("G" & row).Value = rs.Fields(7).Value     
    xlapp.Range("H" & row).Value = rs.Fields(8).Value     
    xlapp.Range("I" & row).Value = rs.Fields(9).Value     
    xlapp.Range("J" & row).Value = rs.Fields(10).Value    
    xlapp.Range("K" & row).Value = ""                     
    xlapp.Range("L" & row).Value = rs.Fields(11).Value    
    xlapp.Range("M" & row).Value = rs.Fields(13).Value   

    If CInt(rs.Fields(2).Value) = 1 Then
        row1 = row1 + 1
    ElseIf CInt(rs.Fields(2).Value) = 2 Then
        row2 = row2 + 1
    ElseIf CInt(rs.Fields(2).Value) = 3 Then
        row3 = row3 + 1
    Else
        row4 = row4 + 1
    End If

    'activate main summary sheet for next outage
    xlapp.Worksheets(1).Activate
    i = i + 1
    rs.MoveNext
Loop`

此外，我应该指出，这一切都发生在 Access 数据库中，该数据库的表是从 SQL 链接的。查询运行速度非常慢，我认为这是使用视图的原因，但这既不是这里也不是那里。您所需要知道的是，由于必须等待记录集返回，因此尝试调试会花费大量时间。我的猜测是它没有检查结果集是否正确为空。有没有一种方法可以检查是否有一个值是 rs.Fields(0) 并以此为基础？那是 ID 列，并且应该始终有一个值。我想知道为什么 rs.EOF 没有捕捉到这一点。

Answer 1

一些观察结果并不构成您问题的答案，但可能会为您指明正确的方向：

更改空记录集/何时停止循环的测试。

将此代码替换

  If Not rs.EOF Then
     rs.MoveFirst
     Do While Not rs.EOF And Not rs.BOF 
       [...]
       rs.MoveNext

为： ... ：

  If rs.RecordCount<> 0
     rs.MoveFirst
     Do While Not rs.EOF
       [...]
       rs.MoveNext

更改第二个记录集的使用方式。

不要为每一行打开一次，针对该行进行筛选，而是打开未筛选的内容并按之前筛选的值排序，然后使用 FindFirst 对其进行导航：

  Set rs = CurrentDb.OpenRecordset("SELECT * FROM DailySummaryMain")
  Set rs2 = CurrentDb.OpenRecordset("SELECT dbo_StatusType.StatusTypeID, dbo_StatusType.Name FROM dbo_StatusType ORDER BY dbo_StatusType.StatusTypeID")
  [...]
  rs2.FindFirst "[StatusTypeID]=" & rs.Fields(3)

...或者使第二个记录集过时。

更好的是，这里看起来有一个单一的值匹配，因为 rs2 永远不会导航到第一个匹配之后，所以为什么不看看是否可以更改保存的 QueryDef“DailySummaryMain”以加入到 dbo_StatusType，以便该值就在那里单个记录集？那么你就根本不需要 rs2 了。

按序数引用字段通常是非常不明智的。

通过向源 SELECT 语句中除 SELECT 语句末尾以外的任何位置添加新字段来完全管理您的例程太容易了。因此，将序数更改为实际字段名称，以便 rs(0) 变为 rs("NameOfFirstField")。

使用 SELECT CASE 而不是链式 If/Then/ElseIf/Else。

将此代码更改为：

  If CInt(rs.Fields(2).Value) = 1 Then
     row = row1
  ElseIf CInt(rs.Fields(2).Value) = 2 Then
     row = row2
  ElseIf CInt(rs.Fields(2).Value) = 3 Then
     row = row3
  Else
     row = row4
  End If

... 如此：

  Select Case rs.Fields(2)
    Case 1
      row = row1
    Case 2
      row = row2
    Case 3
      row = row3
    Case 4
      row = row4
  End Select

或者，因为除了一种情况之外的所有情况都可以从该值构造，因此请执行以下操作：

  If rs.Fields(2) = 4 Then
     row = row4
  Else
     row = Eval("row" & rs.Fields(2))
  End If

上下文并不完全清楚（ row 和 rowN 项的含义不清楚 - 它们是变量吗是某种类型的对象吗？），所以也许最后一个不起作用（Eval()并不总是在它看起来应该起作用的情况下起作用），所以我可能会选择 SELECT CASE。

Excel 可能需要 .Value，但 Access 不需要。

将其更改为：

  xlapp.Range("A" & i).Value = rs.Fields(0).Value

...更改为：

  xlapp.Range("A" & i).Value = rs.Fields(0)

您可能也不需要在 Excel 方面使用它。

Answer 2

65536 很重要，因为它比可以存储在 16 位无符号整数中的最大值多 1。所以有些东西在某处溢出。

这不会是一个 VBA 整数，因为它们是有符号的，但我仍然会用 CLng() 替换 CInt() 并确保像 i 这样的计数器变量 声明为 long

您是否在禁用错误处理的情况下运行它以查看是否引发任何错误？

至于调试，您可以切换到 ADO，运行一次并将结果保存到磁盘 (RS.Save)，然后 RS.Open 该文件以供后续运行。