EXCEL VBA將戶政資料重新整理

因應彰化區國小編班寫了Excel VBA程式，好方便註冊組長整理資料
檔案按此下載

以下是程式碼的部分

Sub 戶政資料重整()


'
' 戶政資料重整 巨集
' 戶政資料重整
' 快速鍵: Ctrl+Shift+a
'
    Dim i As Integer
'
' 先刪除重整表資料
    Sheets("重整表").Select
    lastrow2 = Sheets("重整表").UsedRange.Rows.Count
'   MsgBox (lastrow2)
    Rows("2:" & lastrow2).Delete Shift:=xlUp

 
 
 '再將戶政資料重整
    Sheets("戶政表").Select
    lastrow = Sheets("戶政表").UsedRange.Rows.Count
    lastrow = (lastrow - 1) / 4
    'MsgBox (lastrow)
    j = 2
    For i = 1 To lastrow
 
            Range("A" & j & ":H" & j + 1).Copy
            Sheets("重整表").Range("A" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("A" & j + 2 & ":H" & j + 3).Copy
            Sheets("重整表").Range("I" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        j = j + 4
    Next i
 
 '清除複製資料
    Application.CutCopyMode = False
 
End Sub

Sub 全形數字2半形()
'
' 全形數字2半形 巨集
' 取代全形數字to半形
'
' 快速鍵: Ctrl+Shift+b
'
    Worksheets("重整表").Select
    Columns("P:P").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="１", Replacement:="1", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="２", Replacement:="2", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="３", Replacement:="3", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="４", Replacement:="4", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="５", Replacement:="5", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="６", Replacement:="6", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="７", Replacement:="7", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="８", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="９", Replacement:="9", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="０", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Sub 重整表2新生表2編班繳交表()
'
' 重整表2新生表 巨集
' 重整表2新生表，增加函數
'
' 快速鍵: Ctrl+Shift+c

' 先刪除新生表資料

    Sheets("新生表").Select
    lastrow_newstu = Sheets("新生表").UsedRange.Rows.Count
'   MsgBox (lastrow2)
    If lastrow_newstu > 1 Then
        Rows("2:" & lastrow_newstu).Delete Shift:=xlUp
    '    Selection.Delete Shift:=xlUp
    End If

'判斷重整表有多少筆資料
    lastrow = Sheets("重整表").UsedRange.Rows.Count
    Sheets("新生表").Select
'   MsgBox (lastrow)

 '新增擷取姓名函數
    Range("B2") = "=IF(ISBLANK(重整表!C2),"""",重整表!C2)"
    Range("B2").Copy
    Range("B3:B" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取性別函數
    Range("C2") = "=IF(ISBLANK(重整表!J2),"""",IF(重整表!J2=""男"",1,IF(重整表!J2=""女"",2)))"
    Range("C2").Copy
    Range("C3:C" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取班級函數
    Range("E2") = "=IF(ISERROR(VLOOKUP($B2,IF({1,0},編班結果表!$E$4:$E$303,編班結果表!$B$4:$B$303),2,)),"""",VLOOKUP($B2,IF({1,0},編班結果表!$E$4:$E$303,編班結果表!$B$4:$B$303),2,))"
    Range("E2").Copy
    Range("E3:E" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取座號函數
    Range("F2") = "=IF(ISERROR(VLOOKUP($B2,IF({1,0},編班結果表!$E$4:$F$303,編班結果表!$C$4:$C$303),2,FALSE)),"""",VLOOKUP($B2,IF({1,0},編班結果表!$E$4:$F$303,編班結果表!$C$4:$C$303),2,FALSE))"
    Range("F2").Copy
    Range("F3:F" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取生日(西元)函數
    Range("G2") = "=IF(SEARCH(""/"",重整表!E2)=3,LEFT(重整表!E2,2)+1911&MID(重整表!E2,3,8),LEFT(重整表!E2,3)+1911&MID(重整表!E2,4,8))"
    Range("G2").Copy
    Range("G3:G" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取身分證字號函數
    Range("H2") = "=IF(ISBLANK(重整表!D2),"""",重整表!D2)"
    Range("H2").Copy
    Range("H3:H" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取父親姓名函數
    Range("I2") = "=IF(ISBLANK(重整表!K2),"""",重整表!K2)"
    Range("I2").Copy
    Range("I3:I" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取母親姓名函數
    Range("J2") = "=IF(ISBLANK(重整表!L2),"""",重整表!L2)"
    Range("J2").Copy
    Range("J3:J" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取住址(不含縣市?鎮)函數
    Range("M2") = "=IF(ISBLANK(重整表!P2),"""",重整表!P2)"
    Range("M2").Copy
    Range("M3:M" & lastrow).Select
    ActiveSheet.Paste
 '新增擷取戶籍遷入日期(西元)函數
    Range("P2") = "=IF(SEARCH(""/"",重整表!F2)=3,LEFT(重整表!F2,2)+1911&MID(重整表!F2,3,8),LEFT(重整表!F2,3)+1911&MID(重整表!F2,4,8))"
    Range("P2").Copy
    Range("P3:P" & lastrow).Select
    ActiveSheet.Paste
 
 
 
 
 '重整表2編班繳交表
 '以下的巨集是針對編班繳交表做整理
    Sheets("編班繳交表").Select

 ' 先刪除新生表資料

    Sheets("編班繳交表").Select
    lastrow_randomstu = Sheets("編班繳交表").UsedRange.Rows.Count
    If lastrow_randomstu > 3 Then
        Rows("4:" & lastrow_randomstu).Delete Shift:=xlUp
    End If

 '新增編班表總人數
    Range("F1") = lastrow - 1

 '新增擷取編班繳交表的性別函數
    Range("D4") = "=IF(ISBLANK(重整表!J2),"""",IF(重整表!J2=""男"",1,IF(重整表!J2=""女"",2)))"
    Range("D4").Copy
    Range("D5:D" & lastrow + 2).Select
    ActiveSheet.Paste
 '新增擷取編班繳交表的姓名函數
    Range("E4") = "=IF(ISBLANK(重整表!C2),"""",重整表!C2)"
    Range("E4").Copy
    Range("E5:E" & lastrow + 2).Select
    ActiveSheet.Paste
 '新增擷取編班繳交表的身分證字號函數
    Range("F4") = "=IF(ISBLANK(重整表!D2),"""",重整表!D2)"
    Range("F4").Copy
    Range("F5:F" & lastrow + 2).Select
    ActiveSheet.Paste
 
    Application.CutCopyMode = False
    Range("A1").Select
    'Sheets("編班繳交表").Range("A1").Select

End Sub

相關網頁連結：大成校務資訊系統公告平台