"Excel VBA/兼代課鐘點費分析" 修訂間的差異

於 2017年12月5日 (二) 05:06 的修訂

Sub Replace6by7() ' 社團週，把班週會改為社團活動 ' 正確的資料結構很重要，本程式會檢查資料旳結構的合理性 ' 以2017年10月30日(一)至12月1日(五)而言，共跨5週，分別為第10-14週 ' 其中第10,11,13週為社團週 ' 每班在調代課系統的課表中，在此3週的每一週必各有一節社團活動課，和一節班週會課。 ' 然而，實際上課情況不同於調代課系統中的課表。在社團週，實際上課會把班週會的課，會用來上社團課。 ' 而形成連上兩節社團課。 ' 反之，在班週會週，就會連上兩節班週會。 ' 輸入資料必須經過適當排列，排列順序為 ' 1) 班級 由小到大 ' 2) 週次 由小到大 ' 3) 星期 由小到大 ' 4) 節次 由大到小，因為社團在第7節，而班週會在第6節

   Dim sht1 As Worksheet
   Dim rng1 As Range
   Dim i As Integer
   Dim strClass As String
   Dim strWeek As String
   Dim strDay As String
   Dim strPeriod As String
   Const conClass = 9
   Const conWeek = 6
   Const conDay = 7
   Const conPeriod = 8
   Dim nDay As Integer
   Dim nWeek As Integer
   Dim nClass As Integer
   
   
   
   ScreenUpdating = False
   Set sht1 = Worksheets("第101113週")
   Set rng1 = sht1.Range("A2")
   i = 0
   nClass = 0
   Do Until rng1.Offset(i, 0).Value = ""
       strClass = rng1.Offset(i, conClass).Value
       nWeek = 0
       Do Until (strClass <> rng1.Offset(i, conClass).Value) Or (rng1.Offset(i, 0).Value = "")
           strWeek = rng1.Offset(i, conWeek).Value
           nDay = 0
           Do Until strWeek <> rng1.Offset(i, conWeek).Value Or _
                   (strClass <> rng1.Offset(i, conClass).Value) Or (rng1.Offset(i, 0).Value = "")
               strDay = rng1.Offset(i, conDay).Value
               Do Until (strDay <> rng1.Offset(i, conDay).Value) Or (strWeek <> rng1.Offset(i, conWeek).Value) Or _
                   (strClass <> rng1.Offset(i, conClass).Value) Or (rng1.Offset(i, 0).Value = "")
                   strPeriod = rng1.Offset(i + 1, conPeriod).Value
                   Range(rng1.Offset(i, 1), rng1.Offset(i, 1).End(xlToRight)).Select
                   Selection.Copy
                   rng1.Offset(i + 1, 1).Select
                   ActiveSheet.Paste
                   rng1.Offset(i + 1, conPeriod).Value = strPeriod

' 跳一列

                    i = i + 2
               Loop
               strDay = rng1.Offset(i, conDay).Value
               nDay = nDay + 1
           Loop
           If nDay <> 1 Then
               MsgBox ("nDay error=" & nDay)
           End If
           strWeek = rng1.Offset(i, conWeek).Value
           nWeek = nWeek + 1
       Loop
       If nWeek <> 3 Then
           MsgBox ("nWeek error=" & nWeek)
       End If
       strClass = rng1.Offset(i, conClass).Value
       nClass = nClass + 1
   Loop
   MsgBox ("nClass =" & nClass)
   MsgBox ("Total records=" & i)
   ScreenUpdating = True

End Sub

Sub Replace7by6() ' 班週會週，把社團活動改為班週會 ' 正確的資料結構很重要，本程式會檢查資料旳結構的合理性 ' 以2017年10月30日(一)至12月1日(五)而言，共跨5週，分別為第10-14週 ' 其中第12,14週為社團週 ' 每班在調代課系統的課表中，在此2週的每一週必各有一節社團活動課，和一節班週會課。 ' 然而，實際上課情況不同於調代課系統中的課表。在班週會週，實際上課會把社團的課，會用來上班週會。 ' 而形成連上兩節班週會課。 ' 反之，在社團週，就會連上兩節社團課。

' 輸入資料必須經過適當排列，排列順序為 ' 1) 班級 由小到大 ' 2) 週次 由小到大 ' 3) 星期 由小到大 ' 4) 節次 由小到大，因為社團在第6節，而班週會在第7節

   Dim sht1 As Worksheet
   Dim rng1 As Range
   Dim i As Integer
   Dim strClass As String
   Dim strWeek As String
   Dim strDay As String
   Dim strPeriod As String
   Const conClass = 9
   Const conWeek = 6
   Const conDay = 7
   Const conPeriod = 8
   Dim nDay As Integer
   Dim nWeek As Integer
   Dim nClass As Integer
   
   
   
   ScreenUpdating = False
   Set sht1 = Worksheets("第1214週")
   Set rng1 = sht1.Range("A2")
   i = 0
   nClass = 0
   Do Until rng1.Offset(i, 0).Value = ""
       strClass = rng1.Offset(i, conClass).Value
       nWeek = 0
       Do Until (strClass <> rng1.Offset(i, conClass).Value) Or (rng1.Offset(i, 0).Value = "")
           strWeek = rng1.Offset(i, conWeek).Value
           nDay = 0
           Do Until strWeek <> rng1.Offset(i, conWeek).Value Or _
                   (strClass <> rng1.Offset(i, conClass).Value) Or (rng1.Offset(i, 0).Value = "")
               strDay = rng1.Offset(i, conDay).Value
               Do Until (strDay <> rng1.Offset(i, conDay).Value) Or (strWeek <> rng1.Offset(i, conWeek).Value) Or _
                   (strClass <> rng1.Offset(i, conClass).Value) Or (rng1.Offset(i, 0).Value = "")
                   strPeriod = rng1.Offset(i + 1, conPeriod).Value
                   Range(rng1.Offset(i, 1), rng1.Offset(i, 1).End(xlToRight)).Select
                   Selection.Copy
                   rng1.Offset(i + 1, 1).Select
                   ActiveSheet.Paste
                   rng1.Offset(i + 1, conPeriod).Value = strPeriod

' 跳一列

                    i = i + 2
               Loop
               strDay = rng1.Offset(i, conDay).Value
               nDay = nDay + 1
           Loop
           If nDay <> 1 Then
               MsgBox ("nDay error=" & nDay)
           End If
           strWeek = rng1.Offset(i, conWeek).Value
           nWeek = nWeek + 1
       Loop
       If nWeek <> 3 Then
           MsgBox ("nWeek error=" & nWeek)
       End If
       strClass = rng1.Offset(i, conClass).Value
       nClass = nClass + 1
   Loop
   MsgBox ("nClass =" & nClass)
   MsgBox ("Total records=" & i)
   ScreenUpdating = True

End Sub

Sub AjustClass() ' 將社團週和班週會週調整過的資料寫回原始資料 ' 本程式輸入兩個表，更新一個表 ' 輸入一：社團週 ' 輸入二：班週會週 ' 更新：明細 ' 更新之明細表必須經過適當排列，排列順序為「編號」由小到大 ' 輸入一、二表之編號，可用來作為更新表之列的 Offset

   Dim sht1 As Worksheet
   Dim sht2 As Worksheet
   Dim shtU As Worksheet

   Dim rng1 As Range
   Dim rng2 As Range
   Dim rngU As Range
   Const conPeriod = 8
   
   ScreenUpdating = False
   
   Set sht1 = Worksheets("第101113週") '社團週

' Set sht2 = Worksheets("第1214週") '班週會週

   Set shtU = Worksheets("明細")  '明細
   
   
   
   Set rng1 = sht1.Range("A2")
   Set rngU = shtU.Range("A2")
   
   i = 0
   Do Until rng1.Offset(i, 0).Value = ""
       If rng1.Offset(i, conPeriod).Value = 6 Then
       
           sht1.Range(rng1.Offset(i, 1), rng1.Offset(i, 1).End(xlToRight)).Select
           Selection.Copy
           
           shtU.rngU.Offset(sht1.rng1.Offset(i, 0), 1).Select
           ActiveSheet.Paste
           
       End If
   
       i = i + 1
   Loop
   
   
   MsgBox ("nClass =" & nClass)
   MsgBox ("Total records=" & i)
   ScreenUpdating = True

End Sub