' ' 青点 マクロ ' マクロ記録日 : 1995/6/26 ユーザー名 : H.Miyamoto ' ' Sub 青点(K) With Selection.Font .Name = "MS ゴシック" .FontStyle = "標準" .Size = 10 .Underline = xlThin .ColorIndex = 5 End With End Sub ' ' 赤点 マクロ ' マクロ記録日 : 1995/6/26 ユーザー名 : H.Miyamoto ' ' Sub 赤点(K) With Selection.Font .Name = "MS ゴシック" .FontStyle = "斜体" .Size = 10 .Underline = xlDouble .ColorIndex = 3 End With End Sub ' ' 赤青表示 マクロ ' マクロ記録日 : 1995/6/26 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake 6/14 '97 ' remake May5 '98 ' remake Mar. '99 ' '========= メイン ======================================================================================= Sub 赤青表示() Dim RED, BLUE, NUMB, SUBR, SSUBR, MaxSUBC(21), MinSUBC(21) As Single Dim SSUBC(21), CSSUBC(4, 21) As Long Dim ALL Sheets("得点").Select '学年人数設定 NU = 1 Do Until Cells(NU + 4, 3) = Cells(4, 3) NU = NU + 1 Loop ALL = NU - 1 REDVAL = 40 '赤点の境界値 BLUVAL = 45 '青点の境界値 MinSUBC(20) = 12: MinSUBC(21) = 12 Sheets("得点").Select For NUMB = 1 To ALL RED = 0 BLUE = 0 For SUBJ = 1 To 14 If Len(Cells(NUMB + 4, SUBJ + 3)) > 0 Then GoSub R_B Else GoSub NON Next Cells(NUMB + 4, 23) = RED Cells(NUMB + 4, 24) = BLUE If Cells(NUMB + 4, 19) = "" Or Cells(NUMB + 4, 19) = "****" Then Cells(NUMB + 4, 23) = "**": Cells(NUMB + 4, 24) = "**" End If Next For SUBR = 20 To 21 For NUMB = 1 To ALL If Cells(NUMB + 4, SUBR + 3) <> "**" Then GoSub CALC Next GoSub PRNVAL Next Exit Sub '--------- サブルーチン ---------------------------------------------------------------------------------- NON: 'セル選択 Range(Cells(NUMB + 4, SUBJ + 3), Cells(NUMB + 4, SUBJ + 3)).Select Return R_B: '赤点青点判断&カウント Range(Cells(NUMB + 4, SUBJ + 3), Cells(NUMB + 4, SUBJ + 3)).Select If Cells(NUMB + 4, SUBJ + 3).Value < REDVAL Then 赤点 (K) RED = RED + 1 Else If Cells(NUMB + 4, SUBJ + 3).Value < BLUVAL Then 青点 (K): BLUE = BLUE + 1 End If Return CALC: '合計、データ数、最小値、最大値計算 SSUBC(SUBR) = SSUBC(SUBR) + Cells(NUMB + 4, SUBR + 3) '列方向合計計算 Select Case Cells(NUMB + 4, 1) Case "A" K = 1 Case "B" K = 2 Case "C" K = 3 Case "D" K = 4 Case Else End Select GoSub CALCC1 GoSub MINMAX Return CALCC1: 'クラスデータ合計計算 CSSUBC(K, SUBR) = CSSUBC(K, SUBR) + Cells(NUMB + 4, SUBR + 3) Return MINMAX: If MinSUBC(SUBR) > Cells(NUMB + 4, SUBR + 3) Then '最小値計算 MinSUBC(SUBR) = Cells(NUMB + 4, SUBR + 3) End If If MaxSUBC(SUBR) < Cells(NUMB + 4, SUBR + 3) Then '最大値計算 MaxSUBC(SUBR) = Cells(NUMB + 4, SUBR + 3) End If Return PRNVAL: '合計、最大値、最小値(全体及びクラスデータ)等セル入力 Cells(ALL + 7, SUBR + 3) = SSUBC(SUBR) '全体 Cells(ALL + 8, SUBR + 3) = CSSUBC(1, SUBR) 'Aクラス Cells(ALL + 9, SUBR + 3) = CSSUBC(2, SUBR) 'Bクラス Cells(ALL + 10, SUBR + 3) = CSSUBC(3, SUBR) 'Cクラス Cells(ALL + 11, SUBR + 3) = CSSUBC(4, SUBR) 'Dクラス Cells(ALL + 12, SUBR + 3) = MaxSUBC(SUBR) '最高値 Cells(ALL + 13, SUBR + 3) = MinSUBC(SUBR) '最低値 Return Sheets("マクロボタン").Select Range("A1").Select End Sub ' ' 赤青解除 マクロ ' マクロ記録日 : 1995/7/9 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' Sub 赤青解除() Dim ALL Sheets("得点").Select '学年人数設定 NU = 1 Do Until Cells(NU + 4, 3) = Cells(4, 3) NU = NU + 1 Loop ALL = NU - 1 Sheets("得点").Select Range(Cells(5, 4), Cells(ALL + 4, 25)).Select With Selection.Font .Name = "MS 明朝" .Size = 10 .FontStyle = "標準" .Underline = xlNone .ColorIndex = 1 End With Range("A1").Select Sheets("マクロボタン").Select Range("A1").Select End Sub