báo cáo nhóm Khó khăn từ cơ sở dữ liệu

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 

Từ các hồ sơ cơ sở dữ liệu mẫu trên, tôi muốn tạo ra một báo cáo với các định dạng sau:

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

Trong cơ sở dữ liệu thực tế, có 55.640 hồ sơ với 1.559 ID độc đáo .

Tôi sẽ thực hiện mọi hướng dẫn. Tôi biết rằng tôi cần nhóm theo ID. Tôi biết rằng tôi nên bỏ qua "Ok-" và chỉ làm việc với các giá trị số. Tôi không biết cách xem "Bắt đầu phạm vi" trong bản ghi tiếp theo để xem đó có phải là sự tiếp tục của "Kết thúc phạm vi" trong bản ghi hiện tại hay không.

Answer 1

Đây chỉ là không thể làm trong Ms-access SQL và bạn phải dựa trên VBA

Tôi có 20 phút để lãng phí nên tôi đã làm điều đó cho bạn ...

Với bảng sau tên 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 

tiểu sau tạo báo cáo bạn muốn

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 chứa:

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

Lưu ý rằng điều này hoạt động hoàn hảo với các mẫu dữ liệu mà bạn cung cấp. Nếu bạn đã thể hiện tất cả các khả năng, nó sẽ làm việc với tất cả các bảng của bạn. Nhưng bạn có thể đã quên chỉ định một số trường hợp đặc biệt và bạn sẽ phải điều chỉnh quy trình phù hợp để phù hợp với chúng. Tôi đã nhận xét tất cả các mã đúng cách, do đó bạn có thể hiểu nó và sửa chữa nó một mình nếu cần thiết.

Đây là cách duy nhất để thực hiện. Bạn sẽ không bao giờ đạt được một báo cáo như vậy với một truy vấn và VBA là có cho rằng

---

Sửa

Trong trạng thái này báo cáo sẽ chỉ được lưu trong bộ nhớ và in trong cửa sổ gỡ lỗi. Đó không phải là tối ưu.

Một điều nhanh chóng đầu tiên bạn có thể làm là:

1. tạo ra một hình thức
2. thêm một hộp rất lớn với nó, tên nó TextReport.
3. thêm nút và thêm mã thủ tục vào sự kiện nhấp chuột của nó.
4. ở phần cuối của các thủ tục, thêm một lệnh TextReport.Value = strReport

Tuy nhiên nó không phải là tối ưu nếu bạn có bảng lớn.Một khả năng khác là để sản xuất các kết quả vào một tập tin văn bản:

1. Trong cửa sổ VBA, dưới công cụ/tài liệu tham khảo, kiểm tra thư viện "Microsoft Scripting Runtime"

2. Thích ứng các thủ tục như thế này và nó sẽ ra báo cáo đến 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