这在 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 就在那里
编辑
在这种状态下,报告只会保存在内存中并打印在调试窗口中。这不是最佳选择。
您可以做的第一件事是:
- 创建表单
- 为其添加一个非常大的文本框,将其命名为
TextReport。
- 添加一个按钮,并在其点击事件中添加程序代码。
- 在程序的最后,添加指令
TextReport.Value = strReport
如果您有一张非常大的桌子,这仍然不是最佳选择。另一种可能性是将结果输出到文本文件中:
在 VBA 窗口的工具/参考下,检查库“Microsoft Scripting Runtime”
-
像这样调整过程,它会将报告输出到 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
结束子