Global St, CLSS, CLS, CL, CLNO, KAI, CL_BEG(4), CL_END(4), CL_MEM(4) Sub 人数計算() ' ' クラス人数計算 ' マクロ記録日 : 1999/3/28 ユーザー名 : H.Miyamoto ' クラス番号順並べ替え Sheets("得点").Select NUMB = 1: S = 0 For K = 1 To 4 CL_BEG(K) = NUMB + 4 GoSub DET CL_END(K) = NUMB + 4 CL_MEM(K) = CL_END(K) - CL_BEG(K) + 1 NUMB = NUMB + 1: S = S + CL_MEM(K) Next ALL = S Exit Sub DET: Do Until Cells(NUMB + 4, 1) <> Cells(NUMB + 5, 1) NUMB = NUMB + 1 Loop Return End Sub Sub 定期テストコピー() ' ' 定期テストコピー ' マクロ作成日 : 1998/7/20 ユーザー名 : H.Miyamoto ' remake '99 Mar.18 ' Workbooks.Open FileName:="C3Teiki.XLS" With Assistant.NewBalloon .Button = msoButtonSetOkCancel .Heading = "成績のコピーをします。" .Text = "コピーするテスト名を選択して下さい。" .Labels(1).Text = "1学期" .Labels(2).Text = "2学期" .Labels(3).Text = "3学期成績" .Labels(4).Text = "学年成績" .Labels(5).Text = "5段階" SLabel = .Show End With Select Case SLabel Case 1 KAI = 1 St = "1学期" GoSub TEST Case 2 KAI = 3.5 St = "2学期" GoSub TEST Case 3 KAI = 6 St = "3学期成績" Case 4 KAI = 7 St = "学年成績" Case 5 KAI = 8 St = "5段階" End Select J = 0: YN = "Y" Do Until YN <> "Y" With Assistant.NewBalloon .Button = msoButtonSetCancel .Heading = St + "をコピーします。" .Text = "処理するクラス名を選択して下さい。" .Labels(1).Text = "Aクラス" .Labels(2).Text = "Bクラス" .Labels(3).Text = "Cクラス" .Labels(4).Text = "Dクラス" SLabel = .Show End With Select Case SLabel Case 1 CN = 1: CLSS = "C3A" Case 2 CN = 2: CLSS = "C3B" Case 3 CN = 3: CLSS = "C3C" Case 4 CN = 4: CLSS = "C3D" End Select Workbooks.Open FileName:=CLSS + ".XLS" Windows("C3Teiki.XLS").Activate 人数計算 CLS = CN: CL = CL_BEG(CN) - 1: CLNO = CL_MEM(CN) For N = 1 To CLNO If KAI <> 8 Then GoSub 平均コピー Windows("C3Teiki.XLS").Activate Sheets(St).Select Range(Cells(N + CL, 4), Cells(N + CL, 25)).Select '成績コピー Selection.Copy Windows(CLSS + ".XLS").Activate Sheets(Str(N)).Select Range(Cells(2 + 2 * KAI, 4), Cells(2 + 2 * KAI, 25)).Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range(Cells(2 + 2 * KAI, 25), Cells(2 + 2 * KAI, 25)).Select Selection.NumberFormatLocal = "0" Next With Assistant.NewBalloon .Button = msoButtonSetYesNo .Heading = CLSS + "の" + St + "をコピーしました。" .Text = "続けて他のクラスをコピーしますか。" SLabel = .Show End With If SLabel = -3 Then YN = "Y" Else YN = "N": おしまい (i) Workbooks(CLSS + ".XLS").Close SaveChanges:=True Loop Exit Sub 平均コピー: Windows("C3Teiki.XLS").Activate Sheets(St).Select Range(Cells(CL_END(4) + 3, 4), Cells(CL_END(4) + 3, 25)).Select '全体平均点コピー Selection.Copy Windows(CLSS + ".XLS").Activate Sheets(Str(N)).Select Range(Cells(3 + 2 * KAI, 4), Cells(3 + 2 * KAI, 25)).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range(Cells(3 + 2 * KAI, 21), Cells(3 + 2 * KAI, 21)).Select 'クラス人数⇔全体人数 Application.CutCopyMode = False Selection.Copy Range(Cells(3 + 2 * KAI, 22), Cells(3 + 2 * KAI, 22)).Select ActiveSheet.Paste Application.CutCopyMode = False Windows("C3Teiki.XLS").Activate Range(Cells(CL_END(4) + CN + 3, 21), Cells(CL_END(4) + CN + 3, 21)).Select 'クラス人数コピー Selection.Copy Windows(CLSS + ".XLS").Activate Range(Cells(3 + 2 * KAI, 21), Cells(3 + 2 * KAI, 21)).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Return TEST: With Assistant.NewBalloon .Button = msoButtonSetOkCancel .Heading = "成績のコピーをします。" .Text = "コピーするテスト名を選択して下さい。" .Labels(1).Text = "中間テスト" .Labels(2).Text = "学期成績" SLabel = .Show End With Select Case SLabel Case 1 KAI = KAI St = St + "中間テスト" Case 2 KAI = KAI + 1 St = St + "成績" End Select Return End Sub Sub おしまい(i) With Assistant.NewBalloon .Heading = "お待ちどーさま!" .Text = "コピーが終わりました。" .Show End With End Sub