注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

VBA程序实例  

2012-03-21 13:47:33|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

代码如下:
Public   Function   DBRead(StationName)
        Dim   i,   j,   k   As   Integer
        Dim   ArrB()   As   String
        Dim   strtime   As   String
        Dim   pathname   As   String

        pathname   =   App.Path   &   "\name.xls "

        Rs.ActiveConnection   =   Conn.ConnectionString
        Rs.Source   =   sqlstr
        Rs.Open
       

       
        Set   xlapp   =   CreateObject( "Excel.Application ")
        Set   xlbook   =   xlapp.Workbooks.Open(pathname)
        xlapp.Visible   =   True
        Set   xlSheet   =   xlbook.Worksheets(1)
        xlSheet.Activate
       
               
        If   Rs.BOF   Then
              MsgBox   "没有符合条件的记录!请重新输入条件! "
              Form1.ETimeTxt.Text   =   "YYYY-MM-DD,HH:MM:SS "
              Form1.BTimeTxt.Text   =   "YYYY-MM-DD,HH:MM:SS "
              GoTo   over
        Else
              Do
                    DataVar   =   DataVar   &   Rs( "log_Date ").Value   &   ", "   &   Rs( "log_Time ").Value   &   ", "   &   Rs( "Hcon ").Value   &   ", "   &   Rs( "State ").Value   &   ", "   &   Rs( "Load ").Value   &   ", "   &   Rs( "Allweight ").Value   &   ", "   &   Rs( "MFiux ").Value   &   ", "   &   Rs( "FFiux ").Value   &   "# "
                    Rs.MoveNext
              Loop   Until   Rs.EOF
        End   If
        Rs.Close

               
                'xlSheet.Delete
                'On   Error   Resume   Next
                xlapp.Worksheets.Add
               
                xlSheet.Name   =   StationID
                Set   xlSheet   =   xlbook.Worksheets(StationID)
                xlSheet.Activate
               
                xlSheet.Cells(1,   1)   =   "子站名称 "
                xlSheet.Cells(1,   2)   =   "日期 "
                xlSheet.Cells(1,   3)   =   "时间 "
                xlSheet.Cells(1,   4)   =   "小时浓度 "
                xlSheet.Cells(1,   5)   =   "状态位 "
                xlSheet.Cells(1,   6)   =   "负载率 "
                xlSheet.Cells(1,   7)   =   "总重量 "
                xlSheet.Cells(1,   8)   =   "主流量 "
                xlSheet.Cells(1,   9)   =   "辅流量 "

       
       
        ArrB   =   Split(DataVar,   "# ")
        j   =   2
       
        For   i   =   0   To   UBound(ArrB)
                If   ArrB(i)   <>   " "   Then
                        ArrS   =   Split(ArrB(i),   ", ")
                        ArrS(1)   =   Jud_Time(ArrS(1))
                        If   Len(ArrS(1))   =   7   Then
                                ArrS(1)   =   "0 "   &   ArrS(1)
                        End   If
                        strtime   =   ArrS(0)   &   ", "   &   ArrS(1)
                        If   strtime   > =   Btime   And   strtime   <=   Etime   Then
                              For   k   =   0   To   UBound(ArrS)
                                      xlSheet.Cells(j,   k   +   2)   =   ArrS(k)
                              Next   k
                              xlSheet.Cells(j,   1)   =   StationID
                        End   If
                End   If
                j   =   j   +   1
        Next   i
 
        'xlSheet.Move   After:=Worksheets(Worksheets.Count)

       
over:
        xlbook.Close   (True)   '关闭工作簿
        xlapp.Quit   '结束EXCEL对象
        Set   xlapp   =   Nothing   '释放xlApp对象
End   Function

  评论这张
 
阅读(389)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017