Sub アップダウン() ' ' アップダウン Macro ' マクロ記録日 : 1999/12/15 ユーザー名 : H.Miyamoto ' remake '00/3/25 ' ' Sheets("得点").Select NUMB = 1 Do Until Cells(NUMB + 4, 22) = Cells(4, 22) If (Cells(NUMB + 4, 22) = "***" Or Cells(NUMB + 4, 26) = "***" Or Cells(NUMB + 4, 22) = "" Or Cells(NUMB + 4, 26) = "") Then 'セル入力値判定 GoSub MUKO Else GoSub DEFF End If NUMB = NUMB + 1 Loop Sheets("マクロボタン").Select Range("A1").Select Exit Sub DEFF: DEF = Cells(NUMB + 4, 26) - Cells(NUMB + 4, 22) Select Case DEF Case Is > 0 Cells(NUMB + 4, 27) = "↑" & DEF Case Is < 0 Cells(NUMB + 4, 27) = "↓" & Abs(DEF) Case Is = 0 Cells(NUMB + 4, 27) = "→0" End Select Return MUKO: Cells(NUMB + 4, 27) = "****" Return End Sub ' ' 太字 マクロ ' マクロ作成日 : 2000/3/31 ユーザー名 : H.Miyamoto  -27 ' ' Sub 太字(K) With Selection.Font .Name = "MS ゴシック" .FontStyle = "太字" .Size = 10 .Underline = xlThin ' .ColorIndex = 5 End With End Sub ' ' 斜体 マクロ ' マクロ作成日 : 2000/3/31 ユーザー名 : H.Miyamoto ' ' Sub 斜体(K) With Selection.Font .Name = "MS ゴシック" .FontStyle = "斜体" .Size = 10 .Underline = xlDouble ' .ColorIndex = 3 End With End Sub ' ' 文字属性変更 マクロ ' マクロ作成日 : 2000/3/31 ユーザー名 : H.Miyamoto ' '========= メイン ======================================================================================= Sub 文字属性変更() Dim NUMB, SUBR, SSUBC(4), CSSUBC(4, 3) As Single Dim ALL Sheets("得点").Select '学年人数設定 NU = 1 Do Until Cells(NU + 4, 3) = Cells(4, 3) NU = NU + 1 Loop ALL = NU - 1 Sheets("得点").Select For SUBR = 1 To 3 For NUMB = 1 To ALL If Cells(NUMB + 4, SUBR + 27) <> "" Then GoSub PRO: GoSub CALC Next GoSub PRNVAL Next Exit Sub '--------- サブルーチン ---------------------------------------------------------------------------------- PRO: '属性変更 Range(Cells(NUMB + 4, SUBR), Cells(NUMB + 4, SUBR)).Select If Left(Cells(NUMB + 4, SUBR + 27), 1) = "下" Then 斜体 (K) Else 太字 (K) End If Return CALC: '合計、クラスデータ数計算 SSUBC(SUBR) = SSUBC(SUBR) + 1 '合計加算 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 CSSUBC(K, SUBR) = CSSUBC(K, SUBR) + 1 'クラスデータ数加算 Return PRNVAL: '合計、最大値、最小値(全体及びクラスデータ)等セル入力 Cells(ALL + 7, SUBR + 27) = SSUBC(SUBR) '全体 Cells(ALL + 8, SUBR + 27) = CSSUBC(1, SUBR) 'Aクラス Cells(ALL + 9, SUBR + 27) = CSSUBC(2, SUBR) 'Bクラス Cells(ALL + 10, SUBR + 27) = CSSUBC(3, SUBR) 'Cクラス Cells(ALL + 11, SUBR + 27) = CSSUBC(4, SUBR) 'Dクラス 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, 1), Cells(ALL + 4, 3)).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