excel宏整理
工作以后发现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
