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