VB 宏+mysql解决EXCEL表格实现自动化处理

1、表格模板自动建立源码

Sub opp()
Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False
myPath = "d:\test\"
myFile = Dir(myPath & "*.xls")
Do While myFile <> ""
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)
End If
Call F
    ChDir "D:\test"
    ActiveWorkbook.SaveAs Filename:=AK.Name, _
         FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
myFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

Sub F()

Sheets.Add after:=Sheets(Sheets.Count)
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "主设备"
    Range("b1:h1").Merge
    Range("i1:n1").Merge
    Range("a2") = "设计物资标识（系统唯一）"
    Range("b2") = "物料大类*"
    Range("c2") = "物料中类*"
    Range("d2") = "物料小类*"
    Range("e2") = "物料说明"
    Range("f2") = "单位*"
    Range("g2") = "数量*"
    Range("h2") = "厂家"
    Range("I2") = "物料编码*"
    Range("j2") = "物料名称*"
    Range("k2") = "型号"
    Range("l2") = "物料价值（元）"
    Range("m2") = "箱号*"
    Range("n2") = "领取数量*"
    Range("b1:h1") = "设计单位"
    Range("i1:n1") = "场家"
    Range("B1:H1").Select
    With Selection.Font
        .Name = "宋体"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Bold = True
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
        Range("I1:N1").Select
    With Selection.Font
        .Name = "宋体"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Bold = True
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
        Range("A2:N2").Select
    With Selection.Font
        .Name = "宋体"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Bold = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
    Selection.Font.Bold = False
‘
    Range("A1:N200").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .ColumnWidth = 17.29
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("G4").Select
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "主材"
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "配套"
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "不安装设备"
    Application.DisplayAlerts = False
    Sheets(1).Delete

End Sub

2、数据库调试及表格检测插入

Sub opp()
Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False
myPath = "d:\test\"
myFile = Dir(myPath & "*.xls")
Do While myFile <> ""
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)
End If
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.ConnectionString = "Driver={MySQL ODBC 5.3 Unicode Driver};Server=localhost;DB=test;UID=root;PWD=Changeme_123;OPTION=3;"
conn.Open
rs.Open "select 厂家部件号,厂家部件描述,箱号,数量 from 900m where 发射点名称=‘" & myFile & "‘", conn
Sheets("主设备").Range("I3").CopyFromRecordset rs
Dim x As Integer
Sheets("主设备").Select
x = Range("I65536").End(xlUp).Row
Application.DisplayAlerts = False
Range("K3:L" & x).Select
Selection.Cut
Range("M3").Select
ActiveSheet.Paste
Application.DisplayAlerts = True
rs.Close: Set rs = Nothing
conn.Close: Set conn = Nothing
ChDir "D:\test"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=AK.Name, _
    FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = True
myFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

原文地址：https://www.cnblogs.com/Vidar854/p/10545006.html

时间： 2024-10-14 21:32:41

VB 宏+mysql解决EXCEL表格实现自动化处理的相关文章

通过mysql数据库excel表格数据采集汇总

2017年本人被借调到教育局收集全县的扶贫数据,数据以EXCEL表格的方式分学校上报到乡镇教育管理中心汇总,然后教管中心上报到县资助中心汇总.这项工作看似简单,但却给我带来了无限的烦恼.上报上来的数据来源于百多所学校,而资助中心对数据有严格的要求,但往往上报上来的数据各种问题,不是身份证不对,就是格式有问题,要填的没有填,上报上来的数据不但不能用而且无法进行统计,一但数据有误又得重新上报重新汇总.于是本人有了一个简单的设想,用数据库mysql收集excel表格要,在用户输入数据的时候就验证,对不

java输出mysql到excel表格的简单用法

1>导入包 jxl.jar下载地址:https://pan.baidu.com/s/10ijORF5sNdmZv3SyN8ImaQ密码:ue50 mysql的对应jar:https://pan.baidu.com/s/1ZiB3kPewCdMK_WatNjUtiA密码:7afv 源码: 新建类 public class excelTest { int id; String name; String num; public String getNum() { return num; } publi

VB.NET版机房收费系统---导出Excel表格

datagridview,翻译成中文的意思是数据表格显示,使用DataGridView控件,可以显示和编辑来自不同类型的数据源的表格,将数据绑定到DataGridView控件非常简单和直观,大多数情况下,只需要设置DataSource属性即可,在绑定到包含多个列表或表的数据库源时,只需将DataMember属性设置为绑定的列表或表的字符串即可.机房收费系统多次用到数据表格的显示,并且导出为Excel表格,第一次机房收费系统是用VB版本的,她导出Excel的方法如下: 打开VB-工程-应用-勾选M

Python自动化整理Excel 表格

相信有不少朋友日常工作会用到 Excel 处理各式表格文件,更有甚者可能要花大把时间来做繁琐耗时的表格整理工作.最近有朋友问可否编程来减轻表格整理工作量,今儿我们就通过实例来实现 Python 对表格的自动化整理. 首先我们有这么一份数据表 source.csv: 我们要做的是从上表中提取数据,来生成一份符合以下要求的表格: 按照以下分组名单 group.xls 来整理数据表中的数据: 最终要展现的数据项: 其中"K数据/60"为数据表中的"数据K"/60后保留的2

mysql 表结构转excel表格

最近需要写文档,由于开发模式是先开发后写文档(不想吐槽...),数据库表结构什么的都搞好了,然后写文档的时候需要贴表结构,什么字段,类型,相关说明需要一一对应起来,数据库表10多张,字段又多,手动复制粘贴太蛋疼了,于是就写了个将表结构转excel表格的简单实现(丑是丑了点,毕竟实现功能了不是). package net.cloudkit.management.util; import org.apache.poi.openxml4j.opc.OPCPackage; import org.apac

MySQL 中操作excel表格总结

最近在负责一个项目的落地工作,需要每天导出客户通讯录进行统计各地区注册用户数.使用用户数.未使用用户数.注册不符合规范的用户等等操作,刚开始用户数量比较少,直接在excel中筛选查询就行,但是随着用户数量的增加到几十万,excel筛选已无法满足需求,所有就想着导入到MySQL数据库中进行查询,这样就起到事倍功半的效果. 1.首先用MySQL工具Navicat for MySQL导入excel表,excel表格编码格式为UTF-8格式. 我将excel表格导入MySQL db0库中,也需要设置编码

mysql数据库表格导出为excel表格

在本地数据库中操作如下: 由于excel表格的编码是GBK,所以导出时要加一个设置字符编码: select * from 某个表 into outfile 'd:/文件名.xls' CHARACTER SET gbk;

Python脚本：实现数据库导出数据到excel表格，支持mysql，postergrsql，MongoDB

import xlwt #返回需要导出的对象的集合,根据业务字型实现 def getObjList(): return [] # 制定 表格行 和数据库字段的对应 obj_feild = { 0: 'name', # 表格第一行是名字 1: 'age', # 表格第二行是年龄 2: 'sno', # 表格第三行是学号 3: 'sex', # 表格第四行是性别 } # 制定数据库字段和中文的对应 field_chinese = { 'name':'名字', # 数据库字段 name对应excel表

Excel表格上方工具栏看不到“团队”功能按钮解决办法

由于公司使用的项目管理软件为微软的TFS,所以上传一些数据资料的时候会用微软的Excel来汇总编辑,使用的就是Excel上方工具栏的[团队]功能. 如何使用该功能就不在此赘述了,只记录一下打开Excel表格发现[团队]按钮不见了如何添加回来: 一.打开[开发工具]的COM加载项: 二.选中"TFS Add-in"添加: 原文地址:https://www.cnblogs.com/stilldream/p/12106088.html