VB如何查询数据库-某一天中的某一时段

VB如何查询数据库-某一天中的某一时段,第1张

最简单也是最容易理解的方式,是用两次查询的方法,先查出7月7日0时的使用量,再查出7月8日0时的使用量,两者的差值就是你要的结果了:

.....

rs.open "select 使用量 from x where format(日期,'yyyymmddhh')='2014070700'",conn,1,1

s=rs(0)

rs.close

rs.open "select 使用量 from x where format(日期,'yyyymmddhh')='2014070800'",conn,1,1

s=rs(0)-s

rs.close

MsgBox "7月7日当天0-24点的燃煤总累计使用量为" &s &"吨"

可以快速导出使用excel 就有该功能

Public Function ExportToExcel(ByVal strOpen As String, Title As String, dizhi As String, con As ADODB.Connection)

  '*********************************************************

  '*   名称:ExporToExcel

  '*   功能:导出数据到EXCEL'*   用法:ExporToExcel(strOpen查询字符串,titile

  '*excel标题,dizhi 保存路径,con  数据库连接地址)

  '*********************************************************

lok:  On Error GoTo er

  Screen.MousePointer = 11

  Dim Rs_Data     As New ADODB.Recordset

          Dim Irowcount     As Long

          Dim Icolcount     As Long

         

        Dim XlApp     As New Excel.Application

        Dim xlbook     As Excel.Workbook

        Dim xlSheet     As Excel.Worksheet

        Dim xlQuery     As Excel.QueryTable

         

        With Rs_Data

                If .State = adStateOpen Then

                        .Close

                End If

                 .ActiveConnection = con

                 .CursorLocation = adUseClient

                 .CursorType = adOpenStatic

                 .LockType = adLockReadOnly

                 .Source = strOpen

                 DoEvents

      '           Debug.Print strOpen

                 .Open

                 

         End With

         Debug.Print strOpen

        '  Set Rs_Data = Open_rst_from_str(strOpen)

        With Rs_Data

                If .RecordCount < 1 Then

                        MsgBox ("没有记录!")

                        Screen.MousePointer = 0

                        Exit Function

                End If

                '记录总数

                Irowcount = .RecordCount

                '字段总数

                Icolcount = .Fields.Count

        End With

         

        Set XlApp = CreateObject("Excel.Application")

        Set xlbook = Nothing

        Set xlSheet = Nothing

        Set xlbook = XlApp.Workbooks().Add

        Set xlSheet = xlbook.Worksheets("sheet1")

         

        '添加查询语句,导入EXCEL数据

        Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))

         

        With xlQuery

                .FieldNames = True

                .RowNumbers = False

                .FillAdjacentFormulas = False

                .PreserveFormatting = True

                .RefreshOnFileOpen = False

                .BackgroundQuery = True

                .RefreshStyle = xlInsertDeleteCells

                .SavePassword = True

                .SaveData = True

                .AdjustColumnWidth = True

                .RefreshPeriod = 0

                .PreserveColumnInfo = True

        End With

         

        xlQuery.FieldNames = True       '显示字段名

        xlQuery.Refresh

           

          Dim i     As Integer, Zd       As String

        With xlSheet

                  For i = 1 To 6

               

                          Zd = .Range(.Cells(1, 1), .Cells(1, Icolcount)).item(1, i)

                       '   .Range(.Cells(1, 1), .Cells(1, Icolcount)).Item(1, i) = Lm_YwToZw(Zd)

                  Next

                .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.name = "黑体"

                '设标题为黑体字

  '               .Range(.Cells(1,   1),   .Cells(1,   Icolcount)).Font.Bold   =   True

                '标题字体加粗

                .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous

  '               .Range(.Cells(Irowcount   +   2,   Icolcount)).Text   =   Zje

                '设表格边框样式

        End With

        XlApp.Visible = True

        XlApp.Application.Visible = True

  '      xlBook.SaveAs dizhi

        Set XlApp = Nothing           '"交还控制给Excel

        Set xlbook = Nothing

        Set xlSheet = Nothing

        Screen.MousePointer = 0

        Exit Function

er:

     '   Dispose_Err

     MsgBox err.Description & "           从新导报表,请等待!"

     GoTo lok:

  End Function

使用这个模块就可以,你可以看看引用的函数即可


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/sjk/6719921.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-03-27
下一篇 2023-03-27

发表评论

登录后才能评论

评论列表(0条)

保存