学以致用——Excel连接Oracle生成iKB报告——Part3（功能优化）

最新推荐文章于 2023-02-11 00:17:57 发布
最新推荐文章于 2023-02-11 00:17:57 发布
阅读量698 收藏 2
点赞数
分类专栏： Excel技巧及VBA编程（Excel_VBA） 学以致用—实用程序（iApps） Front End Tech 数据分析（Data Analysis）
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/hpdlzu80100/article/details/75042842
版权

作为一个consultant，其价值就在于做一个problem solver，解决具体问题。

自己写程序的好处就是，对细节的把控程度更高，更容易实现精益求精。

今天，又熬夜优化了一下代码，现在，可以做到从Excel一键提取Oracle数据库iKB汇总数据，进行数据分析及完成自动化日报了。

可以说，自动化程度已经相当之高了。

分享代码：

Sub initialize()

'声明定义VBA语句中需要使用到的各个变量类型
Dim AdoConn As New ADODB.Connection '定义变量AdoConn为连接数据库对象（ADODB是数据库访问组件，Connection是其中的一个对象），用于实现连接数据库连接等操作
Dim D1 As Date                      '定义D1为日期型变量，用于业务日期赋值
Dim D2 As Date                      '定义D2为日期型变量，用于业务日期赋值
Dim i As Integer                    '定义i为循环变量，用于初始化时基于数据库数据循环赋值

'定义SQL语句所需要的4个字符串变量
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String

i = 2                               '表头占用一行，数据从第二行开始


'需在工程中手动添加引用：工具－引用－Microsoft ActiveX Data Objects 2.8 'Library,Microsoft ActiveX Data Objects Recordset 2.8 Library
'建立数据库连接
'AdoConn.Open ("provider=msdaora; data source=orcl; user id=C##SCOTT;password=scott") 'Oracle 12.1.0.2.0-64 版本+Excel2016专业增强版，使用此种连接方式不可行
AdoConn.Open ("provider=OraOLEDB.Oracle.1; data source=orcl; user id=C##SCOTT;password=scott")


'从第二行开始循环赋值
Do While ActiveSheet.Cells(i, "B").Value <> ""
    D1 = ActiveSheet.Cells(i, "B")
    D2 = D1 + 1

    '设置SQL查询语句
    strSQL1 = "SELECT count(termid) FROM ikb"                                '当日词条总数
    strSQL2 = "SELECT count(distinct phase) FROM ikb"      'Phase词条数（去重不为空,下同）
    strSQL3 = "SELECT count(distinct type) FROM ikb"       'type词条数
    strSQL4 = "SELECT count(distinct subtype) FROM ikb"    'subtype词条数
    strSQL5 = "SELECT count(termid) FROM ikb WHERE date_updated < to_date('" & D2 & "') AND date_updated >= to_date('" & D1 & "')"              '更新日期为该日期的词条总数
    strSQL6 = "SELECT count(distinct en) FROM ikb"         'EN词条数
    strSQL7 = "SELECT count(distinct cn) FROM ikb"         'CN词条数
    strSQL8 = "SELECT count(distinct jp) FROM ikb"         'JP词条数
    strSQL9 = "SELECT count(distinct ed) FROM ikb"         'ed词条数
    strSQL10 = "SELECT count(distinct cnd) FROM ikb"       'cnd词条数
    strSQL11 = "SELECT count(distinct jpd) FROM ikb"        'jpd词条数
    
    '执行查询并赋值
    ActiveSheet.Cells(i, 12).CopyFromRecordset AdoConn.Execute(strSQL1)
    ActiveSheet.Cells(i, 3).CopyFromRecordset AdoConn.Execute(strSQL2)
    ActiveSheet.Cells(i, 4).CopyFromRecordset AdoConn.Execute(strSQL3)
    ActiveSheet.Cells(i, 5).CopyFromRecordset AdoConn.Execute(strSQL4)
    ActiveSheet.Cells(i, 13).CopyFromRecordset AdoConn.Execute(strSQL5)
    ActiveSheet.Cells(i, 6).CopyFromRecordset AdoConn.Execute(strSQL6)
    ActiveSheet.Cells(i, 7).CopyFromRecordset AdoConn.Execute(strSQL7)
    ActiveSheet.Cells(i, 8).CopyFromRecordset AdoConn.Execute(strSQL8)
    ActiveSheet.Cells(i, 9).CopyFromRecordset AdoConn.Execute(strSQL9)
    ActiveSheet.Cells(i, 10).CopyFromRecordset AdoConn.Execute(strSQL10)
    ActiveSheet.Cells(i, 11).CopyFromRecordset AdoConn.Execute(strSQL11)

    
    i = i + 1
Loop


AdoConn.Close

Set AdoConn = Nothing

MsgBox "数据提取完毕！"

End Sub


Sub update()

'声明定义VBA语句中需要使用到的各个变量类型
Dim AdoConn As New ADODB.Connection '定义变量AdoConn为连接数据库对象（ADODB是数据库访问组件，Connection是其中的一个对象），用于实现连接数据库连接等操作
Dim D1 As Date                      '定义D1为日期型变量，用于业务日期赋值
Dim D2 As Date                      '定义D2为日期型变量，用于业务日期赋值
Dim N As Integer
'Dim i As Integer                    '定义i为循环变量，用于初始化时基于数据库数据循环赋值

'定义SQL语句所需要的4个字符串变量
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
Dim strSQL5 As String
Dim strSQL6 As String
Dim strSQL7 As String
Dim strSQL8 As String
Dim strSQL9 As String
Dim strSQL10 As String
Dim strSQL11 As String


D1 = Date
D2 = D1 + 1



'需在工程中手动添加引用：工具－引用－Microsoft ActiveX Data Objects 2.8 'Library,Microsoft ActiveX Data Objects Recordset 2.8 Library
'建立数据库连接
'AdoConn.Open ("provider=msdaora; data source=orcl; user id=C##SCOTT;password=scott") 'Oracle 12.1.0.2.0-64 版本+Excel2016专业增强版，使用此种连接方式不可行
 'AdoConn.Open ("provider=OraOLEDB.Oracle.1; data source=orcl; user id=C##SCOTT; password=scott")
 'AdoConn.Open ("Driver={Microsoft ODBC for Oracle}; server=orcl; user id=C##SCOTT; password=scott")
 AdoConn.Open ("provider=OraOLEDB.Oracle.1; data source=orcl; user id=C##SCOTT;password=scott")
 
'      Dim conn As New ADODB.Connection
'      'Dim rs As ADODB.Recordset
'      Dim strConn As String
'      'Dim strconn1 As String
'      Set conn = CreateObject("ADODB.Connection")
'      'Set rs = CreateObject("ADODB.recordset")
'      strConn = "Driver=D:\app\client\pande\product\12.1.0\client_1\oledb\lib\OraOLEDB12.lib;Dbq=orcl;Uid=C##SCOTT;Pwd=scott;" 'OraClient11g_home1为oracle安装目录，Dbq为数据库名
'     conn.Open strConn '打开数据库

N = ActiveSheet.Range("B1").End(xlDown).Row + 1 '获取下一业务日期

    If (ActiveSheet.Cells(N - 1, 2) < Date) Then            '最新一条记录对应的业务日期小于系统日期时，新增记录
   
        '设置SQL查询语句
        strSQL1 = "SELECT count(termid) FROM ikb"                                '当日词条总数
        strSQL2 = "SELECT count(distinct phase) FROM ikb"      'Phase词条数（去重不为空,下同）
        strSQL3 = "SELECT count(distinct type) FROM ikb"       'type词条数
        strSQL4 = "SELECT count(distinct subtype) FROM ikb"    'subtype词条数
        strSQL5 = "SELECT count(termid) FROM ikb WHERE date_updated < to_date('" & D2 & "') AND date_updated >= to_date('" & D1 & "')"              '更新日期为该日期的词条总数
        strSQL6 = "SELECT count(distinct en) FROM ikb"         'EN词条数
        strSQL7 = "SELECT count(distinct cn) FROM ikb"         'CN词条数
        strSQL8 = "SELECT count(distinct jp) FROM ikb"         'JP词条数
        strSQL9 = "SELECT count(distinct ed) FROM ikb"         'ed词条数
        strSQL10 = "SELECT count(distinct cnd) FROM ikb"       'cnd词条数
        strSQL11 = "SELECT count(distinct jpd) FROM ikb"        'jpd词条数
        
        '执行查询并赋值
        ActiveSheet.Cells(N, 1).Value = ActiveSheet.Cells(N - 1, 1).Value + 1
        ActiveSheet.Cells(N, 2).Value = ActiveSheet.Cells(N - 1, 2).Value + 1
        ActiveSheet.Cells(N, 12).CopyFromRecordset AdoConn.Execute(strSQL1)
        ActiveSheet.Cells(N, 3).CopyFromRecordset AdoConn.Execute(strSQL2)
        ActiveSheet.Cells(N, 4).CopyFromRecordset AdoConn.Execute(strSQL3)
        ActiveSheet.Cells(N, 5).CopyFromRecordset AdoConn.Execute(strSQL4)
        ActiveSheet.Cells(N, 13).CopyFromRecordset AdoConn.Execute(strSQL5)
        ActiveSheet.Cells(N, 6).CopyFromRecordset AdoConn.Execute(strSQL6)
        ActiveSheet.Cells(N, 7).CopyFromRecordset AdoConn.Execute(strSQL7)
        ActiveSheet.Cells(N, 8).CopyFromRecordset AdoConn.Execute(strSQL8)
        ActiveSheet.Cells(N, 9).CopyFromRecordset AdoConn.Execute(strSQL9)
        ActiveSheet.Cells(N, 10).CopyFromRecordset AdoConn.Execute(strSQL10)
        ActiveSheet.Cells(N, 11).CopyFromRecordset AdoConn.Execute(strSQL11)
        ActiveSheet.Cells(N, 14).Value = ActiveSheet.Cells(N, 12).Value - ActiveSheet.Cells(N - 1, 12).Value
        ActiveSheet.Cells(N, 15).Value = ActiveSheet.Cells(N, 13).Value - ActiveSheet.Cells(N - 1, 13).Value
        ActiveSheet.Cells(N, 16).Value = ActiveSheet.Cells(N, 14).Value + ActiveSheet.Cells(N - 1, 16).Value
    End If


    If (ActiveSheet.Cells(N - 1, 2) = Date) Then                '最新一条记录对应的业务日期等于系统日期时，仅更新最后一条记录 （即，刷新当前数据）
   
        '设置SQL查询语句
        strSQL1 = "SELECT count(termid) FROM ikb"                                '当日词条总数
        strSQL2 = "SELECT count(distinct phase) FROM ikb"      'Phase词条数（去重不为空,下同）
        strSQL3 = "SELECT count(distinct type) FROM ikb"       'type词条数
        strSQL4 = "SELECT count(distinct subtype) FROM ikb"    'subtype词条数
        strSQL5 = "SELECT count(termid) FROM ikb WHERE date_updated < to_date('" & D2 & "') AND date_updated >= to_date('" & D1 & "')"              '更新日期为该日期的词条总数
        strSQL6 = "SELECT count(distinct en) FROM ikb"         'EN词条数
        strSQL7 = "SELECT count(distinct cn) FROM ikb"         'CN词条数
        strSQL8 = "SELECT count(distinct jp) FROM ikb"         'JP词条数
        strSQL9 = "SELECT count(distinct ed) FROM ikb"         'ed词条数
        strSQL10 = "SELECT count(distinct cnd) FROM ikb"       'cnd词条数
        strSQL11 = "SELECT count(distinct jpd) FROM ikb"        'jpd词条数
        
        '执行查询并赋值
        ActiveSheet.Cells(N - 1, 12).CopyFromRecordset AdoConn.Execute(strSQL1)
        ActiveSheet.Cells(N - 1, 3).CopyFromRecordset AdoConn.Execute(strSQL2)
        ActiveSheet.Cells(N - 1, 4).CopyFromRecordset AdoConn.Execute(strSQL3)
        ActiveSheet.Cells(N - 1, 5).CopyFromRecordset AdoConn.Execute(strSQL4)
        ActiveSheet.Cells(N - 1, 13).CopyFromRecordset AdoConn.Execute(strSQL5)
        ActiveSheet.Cells(N - 1, 6).CopyFromRecordset AdoConn.Execute(strSQL6)
        ActiveSheet.Cells(N - 1, 7).CopyFromRecordset AdoConn.Execute(strSQL7)
        ActiveSheet.Cells(N - 1, 8).CopyFromRecordset AdoConn.Execute(strSQL8)
        ActiveSheet.Cells(N - 1, 9).CopyFromRecordset AdoConn.Execute(strSQL9)
        ActiveSheet.Cells(N - 1, 10).CopyFromRecordset AdoConn.Execute(strSQL10)
        ActiveSheet.Cells(N - 1, 11).CopyFromRecordset AdoConn.Execute(strSQL11)
        ActiveSheet.Cells(N - 1, 14).Value = ActiveSheet.Cells(N - 1, 12).Value - ActiveSheet.Cells(N - 2, 12).Value
        ActiveSheet.Cells(N - 1, 15).Value = ActiveSheet.Cells(N - 1, 13).Value - ActiveSheet.Cells(N - 2, 13).Value
        ActiveSheet.Cells(N - 1, 16).Value = ActiveSheet.Cells(N - 1, 14).Value + ActiveSheet.Cells(N - 2, 16).Value
    End If

AdoConn.Close

Set AdoConn = Nothing

MsgBox "数据提取完毕！"

End Sub

 

更新数据页面：

 

报表正文页面：

 

预见未来to50
关注
  • 0
    点赞
  • 踩
  • 2
    收藏
    觉得还不错? 一键收藏
  • 2
    评论
专栏目录
excel mysql日报_EXCEL日报自动化_2
weixin_36286774的博客
01-19 265
建立“通报正文”表整理好“数据源”表与“数据转化”表后，接下来就该把每条通报正文与图表一一对应起来，按事先拟定的分析框架进行整理。① 新建一张工作表，并命名为“日报正文”。② 在A1单元格处输入通报标题，合并A1：H1单元格，并设置字体大小及排版居中。③ 添加日期下拉输入控件，可直接复制“数据转化”表中已设置好的下拉控件。④ 输入、设置通报正文，例如在B4单元格输入“一、用户规模”，在B5单元格输...
学以致用——Excel连接Oracle生成iKB报告——Part1（使用VBA从数据库提取汇总数据）
预见未来to50的专栏
07-12 716
iKB程序开发出来了，用的很好，很舒服。 用来管理自己的知识库是个非常好的工具，小到一个生字、单词，大到一本书，随便往里装。随意增删改查，都是因为底层使用了强大的Oracle数据库。 那么，有没有办法生成一个报告，告诉我每天更新了多少词条，词条总量等汇总数据呢。 这不，学习数据分析的时候，有个很好的例子出现了，即：Excel报告自动化。 原示例用Excel连接Access，速度明显比Ora
学以致用——Excel连接Oracle生成iKB报告——Part2（Excel日报自动化的数据转换及用户界面）
预见未来to50的专栏
07-12 792
承上篇。 熬夜虽然伤身，但是效率出奇的高。原来心无旁骛的做
学以致用——ikb知识库英文词条词频分析-Part3-使用Excel制作高频词标签云（VBA）
预见未来to50的专栏
07-19 2115
高频词用标签云表现出来还是很漂亮的，在网上下载的刘万祥老师的标签云模板，修改后即可为我所用，制作出非常漂亮而具有统计意义的标签云。 VBA代码： Sub SetTagSize() Application.CalculateFull '刷新随机数，正式不需要 Dim str As String Dim l As Long str = "" For i
学以致用——将iMovie数据批量添加到iKb数据库中
预见未来to50的专栏
07-27 529
辛辛苦苦整理的数据，如果东一块西一块的储存，想用的时候找半天或者根本就找不到，有点可惜。 保存数据这事，还是交给数据库比较靠谱。将这些零散的数据集中到数据库的话，日积月累，数据量可就不得了啦（就看你用数据干什么了）。 闲话少说，数据入库模板如下： 连接公式： =CONCATENATE("INSERT INTO ikb (termid, phase, type, subt
学以致用——iKB知识库日报（改进版）
预见未来to50的专栏
08-04 347
从Oracle数据中提取最新数据，用日报的方式显示汇总信息，起到一目了然的效果。
学以致用——命令行中使用Java模块化技术编译、打包、运行iKb知识库应用
最新发布
预见未来to50的专栏
02-11 962
这个问题随JDK版本和Eclipse版本时隐时现，让人抓狂。在学习Java核心技术（高阶）的过程中，正好学到了相关知识，现决定在CMD命令行中编译、打包、运行该程序，来解决上述问题。说明：编译、打包、运行均有两段代码，第一段适用于JDK8至JDK11，第二段适用于JDK17。也就是说，我的iKb程序目前最高可运行于JDK17中。
学以致用——ikb知识库英文词条词频分析-Part1-数据提取（VBA）
预见未来to50的专栏
07-18 868
课题描述： ikb系统中已录入了数万条记录，多为项目资料（集中在保险、制药两个行业）。这么多数据，能否分析出哪些次出现的次数最多？这些高频词有没有什么业务含义？有什么意义吗？ 众里寻他千百度，蓦然回首，那人却在灯火阑珊处。 本来想在网上搜一下Excel中Frequency函数的原代码，却无意中找到了一段代码，稍作修改，即可帮我实现我长久以来的上述想法：词频分析。 话不多说，直接分享
学以致用——ikb知识库英文词条词频分析-Part2-大数据中高频词分析（Spotfire）
预见未来to50的专栏
07-18 955
承上篇，统计好词的频率后，就需要进行词频分析了。 由于最近工作中一直在使用Spotfire，感觉相当高大上，咱就把这个任务交给Spotfire来完成吧。 分析结果如下： 排名前一百高频词是： No. word count 1 ACCOUNT 1938 2 RIDER
联想Lenovo ideapad 330S 15IKB 美版笔记本Mac Catalina 完美99%
12-22
联想Lenovo ideapad 330S 15IKB 美版 配置如下： CPU：i5-8260U 主板：Intel Kaby Lake-U + iHDCP 2.2 Premium PCH 显卡：Intel UHD Graphics 620 内存： DDR4 2400 8G SSD1：海康威视C2000 256GB NVME SSD...
v330-15ikb-clover:三叶草for v330-15ikb
04-01
v330-15ikb-三叶草 学分 概述无法启动Big Sur 欢迎使用我的Lenovo V330-15IKB macOS Mojave指南。 这款笔记本电脑是一款经济实惠的笔记本电脑，具有强大的升级功能和出色的macOS兼容性。 除了可以以低廉的价格升级...
老版本ikb计费软件
10-25
这个系统可能包含了记录用户使用时间、计算费用、生成账单以及管理会员等功能。在旧版本的软件中，这些功能可能相对简单，但足以满足当时的业务需求。 电子阅览室计费软件的核心功能包括： 1. **用户管理**：登记...
老本拯救计划——联想Ideapad 320S-15IKB笔记本加装SSD教程
易
06-12 3万+
0 写在前面 今天拿到了个笔记本，正好现在的工作需要移动办公，有个笔记本电脑会方便很多，不过从开机开始就感觉卡出了翔，都0202年了这么卡真的忍受不了。先搞个鲁大师看看问题在哪，截图如下 cpu是I5的U，还是双核 内存是D4的8G，忍了 ，硬盘1T5400转，这个就忍不了了，拿机械盘工作就跟上刑具差不多了，那说搞就搞。 1准备工作 首先是看主板支持情况，搜索LNVNB161216这个主板得到的结果是不一样的，有的说可以加装，有的就只能把机械盘拆下来装SSD了。说实话，这还是有些可惜，单SSD真是有些捉襟见
T2I论文阅读笔记——TivGAN 文本生成视频
qq_26136211的博客
03-22 1167
论文源地址：https://arxiv.org/pdf/2009.02018.pdf 出版于2020.8.19 发表在IEEE Access 本人的话：一些翻译不来的词会直接写英文原文。没有网络整体的细节，不建议复现。 摘要 本论文提出了一个全新的框架——Text-to-Image-to-Video GAN（TiVGAN），希望实现从文本生成视频。原理主要是逐帧生成最后成为一段完整的视频。在第一阶段，我们专注于通过学习文本与图片的关系生成一个高质量的单个视频帧，然后再将模型用于更多的连续帧上面。 关键词：计
学以致用——使用VBA发送邮件（Send Email with VBA）
热门推荐
预见未来to50的专栏
06-14 3万+
第一次使用VBA自动发送邮件，酷！示例代码：Sub 邮件发送() Dim cm As New CDO.Message 'Set cm = CreateObject("CDO.Message") '创建对象 '引用路径：C:\Windows\system32\cdosys.dll cm.From = "1234567@qq.com" '设置发信人的邮箱" cm.To = "649725266@qq....
调试经验——ORA-29275: partial multibyte character的解决方案
预见未来to50的专栏
11-08 2万+
问题描述： 有个生产报表运行失败，报错：ORA-29275: partial multibyte character。借助百度、Google前前后后试过多种方法，解决不掉。 后来，想到是否可以更改注册表中的NLS_LANG选项，问题还真解决了。 详细解决方案： 最简方案： 1. 添加系统环境变量NLS_LANG，赋值为AMERICAN_AMERICA.AL32UTF8 2. 无需重启电...
Excel应用-使用VBA自动绘制所有适用类型的Excel图表（代码及效果图）
预见未来to50的专栏
06-13 2万+
深夜，没有睡意。因为，再次发现VBA的魅力。 给出一组数据，如下： 可以绘制多少种Excel图表呢？ 答案是以下70多种（Excel 2016实测）：
Excel使用经验——Excel连接Oracle，发生3706错误的解决办法
预见未来to50的专栏
07-13 1万+
今天真是遇到了一个奇葩问题，花了我四五个小时才解决。 本来昨天写好、调试好的Excel日报功能，今天不能用了。 发生了3706错误（运行时错误‘3706’，未找到提供程序，该程序可能未正确安装）。 于是，在百度上、雅虎（英文网站）上搜索答案，看了几十篇帖子，试了n种方法（安装驱动、改写连接字符串等），都无功而返。 好在自己有种坚持不懈的精神（请允许我自夸一下），想到了是不是Excel账号、
Yoga 710-11IKB笔记本Miray-K主板原理图详解
本文档是关于Yoga 710-11IKB型号的LCFC NM-B011 DYG21 Miray-K笔记本电脑的原理图，该笔记本采用了Intel Kabylake Mobile Ultra平台，搭载了Intel KBLY系列处理器和LPDDR3内存。Miray-K BLM/BSchematics Document的...
评论 2
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值