【问题标题】:Difficult grouped report from database来自数据库的困难分组报告
【发布时间】:2016-09-18 10:49:41
【问题描述】:
ID  |  Start of range | End of range
------------------------------------
ID1 |  Ok-000001      | Ok-000009
ID1 |  Ok-000010      | Ok-000014
ID1 |  Ok-000015      |
ID1 |  Ok-000016      | Ok-000018
ID1 |  Ok-000037      | Ok-000042
ID2 |  Ok-000043      | Ok-000045
ID2 |  Ok-000046      | Ok-000052

从上面的示例数据库记录中,我想生成一个格式如下的报告:

ID1 Ok-000001 - Ok-000018, Ok-000037 - Ok-000042
ID2 Ok-000043 - Ok-000052

在实际数据库中,有 55,640 条记录,具有 1,559 个唯一 ID。

我会接受任何和所有的指导。我知道我需要按 ID 分组。我知道我应该忽略“Ok-”而只使用数值。我不知道如何查看 next 记录中的“范围开始”,看看它是否是当前记录中“范围结束”的延续。

【问题讨论】:

  • 你使用的是哪个RDBMS
  • 我正在使用 Access (2010)
  • 据我所知,这在Ms-Access 并不容易。

标签: sql vba ms-access ms-access-2010


【解决方案1】:

这在 Ms-access SQL 中是不可能做到的,你必须依赖 VBA

我有 20 分钟可以浪费,所以我为你做了...

将下表命名为TableSO

ID  Start of range  End of range
ID1 Ok-000001       Ok-000009      
ID1 Ok-000010       Ok-000014      
ID1 Ok-000015                      
ID1 Ok-000016       Ok-000018      
ID1 Ok-000037       Ok-000042      
ID2 Ok-000043       Ok-000045      
ID2 Ok-000046       Ok-000052   

下面的子生成你想要的报告

Public Sub TableSO_Treatment()

    Dim RST As Recordset
    Dim strReport As String
    Dim strStart As String
    Dim strEnd As String
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim strCurrent As String
    Dim strPrev As String
    Dim strID As String
    Dim strPrevID As String
    Dim strPrevEnd As String
    Dim strLastStart As String

    Dim intPrev As Long

    Set RST = CurrentDb.OpenRecordset("SELECT ID, [Start of range] as start, [End of range] as end FROM TableSO ORDER BY [Start of range]")

    'init before loop
    strLastStart = Trim(RST!start)
    strPrevID = Trim(RST!ID)
    strCurrent = Trim(RST!ID) & " " & strLastStart


    ' Loop on all records
    While Not RST.EOF

        ' Init loop  value
        strID = RST!ID
        strStart = Trim(NZ(RST!start,""))
        strEnd = Trim(NZ(RST!end,""))

        ' if End Range empty give it the Start range value
        If strEnd = "" Then strEnd = strStart

        ' Make numbers out of the ranges
        lngStart = Val(Replace(strStart, "Ok-", ""))
        lngEnd = Val(Replace(strEnd, "Ok-", ""))


        ' Test if it's a new ID
        If strID <> strPrevID Then

            ' Its another ID !!!

            ' write new line
            strReport = strReport & strCurrent & " - " & strPrevEnd & vbCrLf

            'reinit curent line
            strCurrent = strID & " " & strStart
            strLastStart = strStart

        End If


        ' Test if we are in a streak of ranges
        If (lngprev + 1) = lngStart Then

            ' We are in a streak, do nothing

        Else

            ' The streak is broken, write current streak and init a new streak
            strCurrent = strCurrent & " - " & strPrevEnd & ", " & strStart

            'reinit the start range
            strLastStart = strStart

        End If

        ' Saving previous values for the next loop
        lngprev = lngEnd
        strPrevEnd = strEnd
        strPrevID = strID


        RST.MoveNext
    Wend

    ' Last write
    strReport = strReport & strCurrent & " - " & strEnd & vbCrLf

    ' Et voila :)
    Debug.Print strReport
End Sub

StrReport 包含:

ID1 Ok-000001 - Ok-000018, Ok-000037 - Ok-000042
ID2 Ok-000043 - Ok-000052

请注意,这与您提供的数据样本完美配合。如果您已经展示了所有可能性,它将适用于您的所有桌子。 但是您可能忘记指定一些特殊情况,您必须相应地调整程序以匹配它们。我已经正确注释了所有代码,以便您可以理解并在需要时自行修复。

这是唯一的方法。您将永远无法使用查询获得这样的报告,而 VBA 就在那里


编辑

在这种状态下,报告只会保存在内存中并打印在调试窗口中。这不是最佳选择。

您可以做的第一件事是:

  1. 创建表单
  2. 为其添加一个非常大的文本框,将其命名为TextReport
  3. 添加一个按钮,并在其点击事件中添加程序代码。
  4. 在程序的最后,添加指令TextReport.Value = strReport

如果您有一张非常大的桌子,这仍然不是最佳选择。另一种可能性是将结果输出到文本文件中:

  1. 在 VBA 窗口的工具/参考下,检查库“Microsoft Scripting Runtime

  2. 像这样调整过程,它会将报告输出到 C:/AccessReport.txt

    公共子表SO_Treatment()

    Dim RST As Recordset
    Dim strReport As String
    Dim strStart As String
    Dim strEnd As String
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim strCurrent As String
    Dim strPrev As String
    Dim strID As String
    Dim strPrevID As String
    Dim strPrevEnd As String
    Dim strLastStart As String
    Dim intPrev As Long
    
    ' variables to output to a file :
    Dim objFSO As New Scripting.FileSystemObject
    Dim objFile As Scripting.TextStream
    Const fsoForWriting = 2
    Set objFile = objFSO.OpenTextFile("C:\AccessReport.txt", fsoForWriting, True)
    
    
    Set RST = CurrentDb.OpenRecordset("SELECT ID, [Start of range] as start, [End of range] as end FROM TableSO ORDER BY [Start of range]")
    
    'init before loop
    strLastStart = Trim(RST!start)
    strPrevID = Trim(RST!ID)
    strCurrent = Trim(RST!ID) & " " & strLastStart
    
    
    ' Loop on all records
    While Not RST.EOF
    
        ' Init loop  value
        strID = RST!ID
        strStart = Trim(Nz(RST!start, ""))
        strEnd = Trim(Nz(RST!End, ""))
    
        ' if End Range empty give it the Start range value
        If strEnd = "" Then strEnd = strStart
    
        ' Make numbers out of the ranges
        lngStart = Val(Replace(strStart, "Ok-", ""))
        lngEnd = Val(Replace(strEnd, "Ok-", ""))
    
    
        ' Test if it's a new ID
        If strID <> strPrevID Then
    
            ' Its another ID !!!
    
            ' write new line
            strReport = strReport & strCurrent & " - " & strPrevEnd & vbCrLf
            objFile.WriteLine strCurrent & " - " & strPrevEnd
    
            'reinit curent line
            strCurrent = strID & " " & strStart
            strLastStart = strStart
    
        End If
    
    
        ' Test if we are in a streak of ranges
        If (lngprev + 1) = lngStart Then
    
            ' We are in a streak, do nothing
    
        Else
    
            ' The streak is broken, write current streak and init a new streak
            strCurrent = strCurrent & " - " & strPrevEnd & ", " & strStart
    
            'reinit the start range
            strLastStart = strStart
    
        End If
    
        ' Saving previous values for the next loop
        lngprev = lngEnd
        strPrevEnd = strEnd
        strPrevID = strID
    
    
        RST.MoveNext
    Wend
    
    ' Last write
    strReport = strReport & strCurrent & " - " & strPrevEnd & vbCrLf
    objFile.WriteLine strCurrent & " - " & strPrevEnd
    
    
    ' Et voila :)
    Debug.Print strReport
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    

    结束子

【讨论】:

  • 看来SO毕竟是一个代码编写服务。 :) 但是,是的,有些问题很有趣。
  • 托马斯 G,你太棒了。在我对我的数据进行测试后,我会再次在这里发表评论。
  • 毋庸置疑,Thomas G,你遥遥领先。
  • 毋庸置疑,Thomas G,你遥遥领先于我。我理解您的代码,但我从未实现过您编写的子例程。这是我实现它的方式...我创建了一个空白报表,进入设计视图,单击代码按钮,将您的子例程插入报表模块,更改 OpenRecordset 语句中的表名称,保存,创建一个打开事件调用你的子程序。当我运行报告时,语句“strEnd = Trim(RST!end)”上出现运行时错误“94”“无效使用 Null”。可能是您警告我的那些特殊情况之一。 :-)
  • @JWB 发生这种情况是因为您的空 [end range] 包含一个 NULL 值,而不是我预期的空白字符串。您必须将该指令更改为 Trim(NZ(RST!end,"")) 才能将空值更改为空白字符串。我调整我的程序。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2016-11-04
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多