AI 助理
备案控制台
开发者社区 数据库 文章 正文

excel宏整理

2017-12-20 1348
版权
版权声明：
本文内容由阿里云实名注册用户自发贡献，版权归原作者所有，阿里云开发者社区不拥有其著作权，亦不承担相应法律责任。具体规则请查看《 阿里云开发者社区用户服务协议》和 《阿里云开发者社区知识产权保护指引》。如果您发现本社区中有涉嫌抄袭的内容，填写 侵权投诉表单进行举报，一经查实，本社区将立刻删除涉嫌侵权内容。
简介：

工作以后发现excel很强大，用好excel已经成功工作中很重要的一部分内容，最近写了一些宏， 整理如下：

根据excel生成sql脚本的sc_template

复制代码 
Sub GenSCTemplateFile()
    Dim WS As Worksheet
    Dim WS_Config As Worksheet
    Set WS_Config = ThisWorkbook.Worksheets("Config")
    
    Dim turbineModelSheetName As String
    turbineModelSheetName = WS_Config.Cells(2, 2).Value
    Set WS = ThisWorkbook.Worksheets(turbineModelSheetName)

    
    Dim Model_Name As String
    Model_Name = WS_Config.Cells(1, 2).Value
    
    Dim fn As Integer
    Dim fname As String
    fname = ThisWorkbook.Path & "\" & "SC_Template_" + WS.Name + ".sql"
    fn = FreeFile
    
    Open fname For Output Shared As #fn
    
    Print #fn, Spc(0); "delete from sc_template where wtg_model_id = -1;"
    Print #fn, Spc(0); "delete from sc_template where wtg_model_id = (select wtg_model_id from wtg_model_para where wtg_model_name = '" + Model_Name + "');"
    
    Call GenSCTemplate(WS, fn)
    
    Print #fn, Spc(0); "update sc_template set wtg_model_id = (select wtg_model_id from wtg_model_para where wtg_model_name = '" + Model_Name + "') where wtg_model_id=-1;"
    
    Call GenWarnLevel(WS_Config, fn)
    
    Close #fn
    
    MsgBox "Finish: " + fname
End Sub


Sub GenWarnLevel(ByRef sheet As Worksheet, ByRef fileNo As Integer)
    Dim finalRow As Long
    finalRow = sheet.UsedRange.Rows.Count '求行数
    
    Dim i As Long
    For i = 1 To finalRow
        If IsEmpty(sheet.Cells(i, 4)) Then Exit For
        
        Dim alarm_level As Integer
        If (sheet.Cells(i, 4) = "F") Then
            alarm_level = 3
        ElseIf (sheet.Cells(i, 4) = "A") Then
            alarm_level = 2
        Else
            alarm_level = 1
        End If
        
        Dim strSql As String
        strSql = "update sc_template set alarm_level = (select warntype_id from warn_type_define where WARNTYPE_ID = " + CStr(sheet.Cells(i, 5)) + ") where alarm_level = " + _
            CStr(alarm_level) + ";"
            
        Print #fileNo, Spc(0); strSql
    Next '与for组成完整循环
    
        strSql = "delete from sc_template where wtg_model_id = -1;"
        Print #fileNo, Spc(0); strSql
        strSql = "commit;"
        Print #fileNo, Spc(0); strSql
        strSql = "exit;"
        Print #fileNo, Spc(0); strSql
End Sub


Sub GenSCTemplate(ByRef sheet As Worksheet, ByRef fileNo As Integer)
    Dim finalRow As Long
    finalRow = sheet.UsedRange.Rows.Count '求行数
    
    Dim i As Long
    For i = 2 To finalRow '从第二行开始，第一行是标题
        If IsEmpty(sheet.Cells(i, 1)) Then Exit For
        
        Dim sc_id As Long
        
        If (Left(sheet.Cells(i, 1), 3) = "SC_") Then '对于SC_GW05_0001,取值为1
            sc_id = Val(Right(sheet.Cells(i, 1), 4))
           ' MsgBox (sc_id)
            
        Else
            sc_id = number(sheet.Cells(i, 1)) '求单元格字符串中的数值，比如SC01_01_02结果应该是10102，SC0001取值为1
        End If
            
        
        Dim desc_eng As String
        desc_eng = Replace(sheet.Cells(i, 2), "'", "''") '考虑到应为所写使用'这个符号
        
        

        Dim ss_group_id As Long 'ss_id
        ss_group_id = number(sheet.Cells(i, 6))
        
    
        Dim en_level_id As Long '远景sc level
        en_level_id = number(sheet.Cells(i, 5))
        
        Dim alarm_level As Integer
        If (sheet.Cells(i, 7) = "F") Then
            alarm_level = 3
        ElseIf (sheet.Cells(i, 7) = "A") Then
            alarm_level = 2
        Else
            alarm_level = 1
        End If
        
        Dim strSql As String
          strSql = "insert into sc_template(wtg_model_id, sc_id, sc_name, desc_eng, desc_chn, ss_group_id, alarm_flag, alarm_level, trouble_flag, system_id, EQUIPMENT_ID, reason_id, RESPONSIBILITY_ID, EN_LEVEL, EN_BRAKELEVEL) values (" + _
            "-1," + _
            CStr(sc_id) + "," + _
            "'" + sheet.Cells(i, 1) + "'," + _
            "'" + desc_eng + "'," + _
            "'" + sheet.Cells(i, 3) + "'," + _
            CStr(ss_group_id) + "," + _
            "1," + _
            CStr(alarm_level) + "," + _
            CStr(sheet.Cells(i, 16)) + "," + _
            CStr(sheet.Cells(i, 9)) + "," + _
            CStr(sheet.Cells(i, 11)) + "," + _
            CStr(sheet.Cells(i, 13)) + "," + _
            CStr(sheet.Cells(i, 15)) + "," + _
            CStr(en_level_id) + "," + _
            CStr(sheet.Cells(i, 4)) + ");"
            
        Print #fileNo, Spc(0); strSql
     Next
     
End Sub


'求字符串中的数字，比如传入SC0001，输出结果是1
'基本思路是通过判断每个字符的ASCII值
Function number(LY As Range)
For i = 1 To Len(LY)
If Asc(Mid(LY, i, 1)) >= 48 And Asc(Mid(LY, i, 1)) <= 57 Then s = s & Mid(LY, i, 1)
Next
number = s
End Function
复制代码

 

 

自动编码宏

复制代码 
Sub 位置编码()



    Dim WS As Worksheet
    Dim WS_Config As Worksheet '定义配置信息页
    Set WS_Config = ThisWorkbook.Worksheets("Config")
    
    Dim executelSheetName As String '定义需要执行宏的sheet名称
    executelSheetName = WS_Config.Cells(3, 2).Value
    Set WS = ThisWorkbook.Worksheets(executelSheetName)


    Dim finalRow As Long
    finalRow = WS.UsedRange.Rows.Count '求行数
    
    Dim a, b
    a = WS_Config.Cells(1, 2).Value
    b = WS_Config.Cells(2, 2).Value
    
    If ((a * b + 1) <> finalRow) Then
        MsgBox "台账记录数量不对，应为：风机台数*子设备数量"
        
    ElseIf (WS.Sort.SortFields.Count <> 2) Then '位置编码需要进行双重条件排序：设备描述+风机，其实这样判断也不严谨，但是多一重判断也是好的。
        MsgBox "排序规则不对，请自定义排序规则：设备描述+风机"
        
    Else
        Dim j As Long '定义行标
        Dim L As Long '定义风机台数
        L = WS_Config.Cells(1, 2).Value
        
        Dim i As Long
        For i = 2 To finalRow '从第二行开始，第一行是标题
            j = i + L - 1
            WS.Range(Cells(i, 3), Cells(i, 4)).Select '选中C2:D2
            Selection.AutoFill Destination:=WS.Range(Cells(i, 3), Cells(j, 4)) '序列化
            WS.Range(Cells(i, 3), Cells(j, 4)).Select
            i = j
        Next
    End If

End Sub


Sub 设备编码()

    Dim WS As Worksheet
    Dim WS_Config As Worksheet '定义配置信息页
    Set WS_Config = ThisWorkbook.Worksheets("Config")
    
    Dim executelSheetName As String '定义需要执行宏的sheet名称
    executelSheetName = WS_Config.Cells(3, 2).Value
    Set WS = ThisWorkbook.Worksheets(executelSheetName)

    
'获取hashmap数据
    Dim arr, d, i
    Set d = CreateObject("scripting.dictionary") '定义字典类
    arr = WS.Range("j1").CurrentRegion '定义数组类,要求的就是这一列当中的个数
    For i = 2 To UBound(arr)
        d(arr(i, 10)) = d(arr(i, 10)) + 1 '相当于是一个hashmap，保存key-value，为后面做准备。
    Next
    
'测试
     Dim bb
      bb = d(arr(2, 10))  '获取行数
    
'开始序列化

    Dim finalRow As Long
    finalRow = WS.UsedRange.Rows.Count '求行数
    
    Dim a, b
    a = WS_Config.Cells(1, 2).Value
    b = WS_Config.Cells(2, 2).Value
    
    If ((a * b + 1) <> finalRow) Then
        MsgBox "台账记录数量不对，应为：风机台数*子设备数量"
        
    ElseIf (WS.Sort.SortFields.Count <> 3) Then '位置编码需要进行双重条件排序：系统层+风机+设备编码，其实这样判断也不严谨，但是多一重判断也是好的。
        MsgBox "排序规则不对，请自定义排序规则：系统层+风机+设备编码"
        
    Else
        Dim j As Long '行
        Dim L As Long '用户获取序列化的行数
        Dim cRange As String
        For i = 2 To finalRow '从第二行开始，第一行是标题
            L = d(arr(i, 10)) '获取第j列系统层的个数
            j = i + L - 1
            cRange = "E" & Trim(Str(i)) & ":E" & Trim(Str(j)) '组装序列化区域，必须通过这样的方法。
            WS.Cells(i, 5).Select '如果只有一个单元格，在使用Cells.select，如果是多个单元格，则使用Range(Cells(),Cells()).这一行非常重要
            Selection.AutoFill Destination:=WS.Range(cRange), Type:=xlFillDefault
            WS.Range(cRange).Select
            i = j
        Next
    End If
    
    

End Sub


Sub 自动按800行分裂()

   
    Dim WS_Config As Worksheet '定义配置信息页
    Set WS_Config = ThisWorkbook.Worksheets("Config")
    
    Dim executelSheetName As String '定义需要执行宏的sheet名称
    executelSheetName = WS_Config.Cells(5, 2).Value
    
    Dim sheet As Worksheet
    Set sheet = ThisWorkbook.Worksheets(executelSheetName)
    
    

    Dim finalRow As Long
    finalRow = sheet.UsedRange.Rows.Count '求行数
    
    Dim sheetcount As Integer '定义要生成的sheet的数量
    Dim rowcount As Integer
    rowcount = WS_Config.Cells(6, 2).Value '定义每一个sheet当中有多少行
    
    If (rowcount > 800) Then
        MsgBox "最大记录数不得超过800"
    Else
        sheetcount = Int(finalRow / rowcount) + 1 'vba中整除使用的是四舍五入，所以这里要取整再加一。
        Dim i As Long
        Dim s '起始坐标
        Dim e '结束坐标
        s = 2 '起始从第二行开始
        e = s + rowcount - 1
        
        Dim WS As Worksheet '定义新增的sheet
        For i = 1 To sheetcount
            Set WS = Worksheets.Add
            WS.Name = i '新建一个sheet，以编号命名
            
            '复制抬头
            sheet.Select '选中源数据sheet
            sheet.Range(Cells(1, 1), Cells(1, 7)).Select '选中第一行台头
            Selection.Copy '拷贝
            WS.Select '选中目标sheet
            Cells(1, 1).Select '选中第一个单元格
            WS.Paste '粘贴
            
            '复制数据
            sheet.Select '选中源数据sheet
            sheet.Range(Cells(s, 1), Cells(e, 7)).Select '选中790行数据
            Selection.Copy '拷贝
            WS.Select '选中目标sheet
            Cells(2, 1).Select '选中第一个单元格
            WS.Paste '粘贴
          
            s = e + 1
            e = s + rowcount - 1
        Next
    End If
    

End Sub
复制代码

 

 

 本文转自xwdreamer博客园博客，原文链接http://www.cnblogs.com/xwdreamer/p/3227740.html，如需转载请自行联系原作者

 

文章标签：
SQL
嗯哼9925
目录
相关文章
南城余
|
人工智能 Windows
基于语雀的windows解决小问题知识库
基于语雀的windows解决小问题知识库
南城余
164 0
Hcoco_me
|
存储 缓存 Linux
Linux内核学习（九）：linux内核的特殊文件系统-debugfs、ftrace、sys
Linux内核学习（九）：linux内核的特殊文件系统-debugfs、ftrace、sys
Hcoco_me
439 0
derek武汉
|
供应链 算法 定位技术
运筹优化技术在供应链领域应用介绍
运筹优化技术在供应链领域应用介绍
derek武汉
1052 0
明哥的IT随笔
|
分布式计算 安全 Hadoop
聊聊 hadoop 与 sasl 安全框架
聊聊 hadoop 与 sasl 安全框架
明哥的IT随笔
440 0
王二蛋呀
|
Java 关系型数据库 API
Spring Cloud微服务面试题
Spring Cloud微服务面试题
王二蛋呀
471 0
阿文没烦恼
|
存储 API Python
python之代理ip的配置与调试
python之代理ip的配置与调试
阿文没烦恼
291 7
风水道人
|
应用服务中间件 nginx
nginx配置https和直接访问静态文件的方式
nginx配置https和直接访问静态文件的方式
风水道人
361 3
请看我回答~
|
数据可视化 JavaScript 前端开发
数据可视化技术与工具：D3.js 和 Tableau 的比较和选择
数据可视化是当今分析和决策制定的关键步骤。D3.js 和 Tableau 是两个广泛使用的可视化工具。本文将探讨它们的优缺点，以及在选择何种工具时应该考虑的因素。
请看我回答~
277 3
游客rihqhtgkydneq
|
前端开发 安全 JavaScript
x-www-form-urlencoded 是什么？
在开发网站时，我们常常需要将用户填写的表单信息发送给服务器，而其中一种被广泛接受和使用的方法是使用 application/x-www-form-urlencoded 编码格式。本篇文章旨在探讨该编码格式的细节和应用场景，帮助开发者更有效地管理和发送表单数据。
游客rihqhtgkydneq
522 0
弹性计算-小弹
|
机器学习/深度学习 人工智能 并行计算
AI 时代的 GPU 生存工具包，每个开发人员必须知道的最低限度
AI技术迎来了“百花齐放”的春天，这既是我们的挑战也是机会。而AI+千行百业创造了无限可能，也为独立开发者提供了大量的资源、支持以及学习经验的机会。本文分享一篇摘录自Hexmos 期刊的AI 时代的 GPU 生存工具包。
弹性计算-小弹
80146 7