请问高手,要得到如下报表,如何设计数据库,如何显示结果

Question

建议自己用Select计算其结果以后导出到Excel

Answer 1

Private Type ExlCell
    Row As Long
    Col As Long
End TypeDim ExcelSheet As Excel.Application
Dim ValuesArray() As StringPublic Function MakeExcelFile(MasterRs As ADODB.Recordset, FieldsArray() As String, _
            ReportCaption As String, MasterForm As frmCreateReport)
    
    Dim WS As Worksheet
    Dim StCell As ExlCell
    
    Screen.MousePointer = vbHourglass    Set ExcelSheet = CreateObject("Excel.Application")
    ExcelSheet.Workbooks.Add
    ExcelSheet.Worksheets(1).Name = ReportCaption
    Set WS = ExcelSheet.Worksheets(1)
    
    StCell.Col = 1
    StCell.Row = 3
    Call CopyRecords(MasterRs, WS, StCell, FieldsArray, MasterForm)
    Screen.MousePointer = vbDefault
    
    ExcelSheet.Visible = True
    ExcelSheet.Interactive = True
    Set ExcelSheet = Nothing
End Function
Private Sub CopyRecords(RST As ADODB.Recordset, WS As Worksheet, StartingCell As ExlCell, _
                    FieldsArray() As String, MasterForm As frmCreateReport)
    
    Dim SomeArray() As Variant
    Dim Row         As Long
    Dim Col         As Long
    Dim Recs As Integer
    Dim Counter As Integer
    Dim i As Integer
    
    If RST.EOF And RST.BOF Then Exit Sub
    RST.MoveLast
    ReDim SomeArray(RST.RecordCount + 1, UBound(FieldsArray))
    Col = 0
    For Col = 0 To UBound(FieldsArray)
        SomeArray(0, Col) = FieldsArray(Col)
    Next
    RST.MoveFirst
    Recs = RST.RecordCount
    Counter = 0
    For Row = 1 To RST.RecordCount
        Counter = Counter + 1
        If Counter <= Recs Then i = (Counter / Recs) * 100
        MasterForm.UpdateProgress i
        For Col = 0 To UBound(FieldsArray)
            SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value
            If IsNull(SomeArray(Row, Col)) Then _
            SomeArray(Row, Col) = ""
        Next
        RST.MoveNext
    Next    WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
        WS.Cells(StartingCell.Row + RST.RecordCount, _
        StartingCell.Col + UBound(FieldsArray))).Value = SomeArray
    
    WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
        WS.Cells(StartingCell.Row + RST.RecordCount, _
        StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlRight
    WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
        WS.Cells(StartingCell.Row + RST.RecordCount, _
        StartingCell.Col + UBound(FieldsArray))).Borders.LineStyle = xlContinuous
        
        
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Merge
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Size = 20
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Bold = True
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Value = WS.Name
    WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlCenter
    WS.Columns.AutoFit
    MasterForm.UpdateProgress 100
End Sub