Question

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

在实际数据库中，有544条记录，其中包含1,559个唯一ID。

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

Answer 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

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

这是唯一的出路。您将永远不会使用Query获得此类报告，而VBA就是为此而生成的

修改

在此状态下，报告将保存在内存中并在调试窗口中打印。那不是最佳的。

你可以做的第一件事就是：

创建表单

为其添加一个非常大的文本框，将其命名为TextReport。

添加一个按钮，并在其点击事件中添加过程代码。

在程序结束时，添加说明TextReport.Value = strReport

如果你有一个非常大的桌子，它仍然不是最佳选择。另一种可能性是将结果输出到文本文件中：

在VBA窗口的工具/参考下，检查库“ Microsoft Scripting Runtime ”

调整此过程并将报告输出到C：/AccessReport.txt

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 ' 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

End Sub

来自数据库的困难分组报告

1 个答案: