ニャン太郎の叫び

２５ 練習問題４ 学級記録用文漢字とひらがな名簿の作成

２３番で作成したものにひらがなも表示します。２４番の練習問題３とほぼ同じです。

問題　上記の写真のように、学級記録用文に漢字とひらがな名簿を作成する。

３０分以内でできれば合格です。

解答
３０分以内でできれば合格としたいと思います。そのためには、エクセルの効率良く利用すること、VBAでは、今まで使ったものを利用できるかです。

＊学級記録用文漢字とひらなが名簿のシートを作成する。
・シート「gm3」をコピーして、できたシートの名前を「gm5」とする。
＊「窓口」シートに「漢字ひらがな」ボタンを作成する。
・ボタン「漢字ひらがな」をダブルクリックをし、コードウインドウを開き次のような命令文を書く。

Private Sub CommandButton3_Click()
    Worksheets("gm5").Activate
    Worksheets("gm5").Range("B2").Select
End Sub

＊シート「gm5」に表示したいデータや枠を書き換える。

・Module３に「クラス５」のマクロを下記のように書く。

Sub クラス5()
    Call hanik2
    If gyou = 3 Then
      gyou = 4
    End If
     Range(Cells(4, 1), Cells(gyou, retu)).Value = ""
     Call 罫線を消す
     Range("a4").Select
     g = 4
        Do Until Worksheets("表１").Cells(g, "f").Value = ""
           With ActiveCell
            If Worksheets("表１").Cells(g, "c").Value = _
            Cells(2, "e") And _
            Worksheets("表１").Cells(g, "d").Value = _
            Cells(2, "g") Then
            .Value = Worksheets("表１").Cells(g, "e").Value
            .Offset(0, 1).Value = Worksheets("表１").Cells(g, "f").Value
            .Offset(0, 2).Value = Worksheets("表１").Cells(g, "g").Value
            .Offset(1, 0).Select
            End If
            g = g + 1
           End With
        Loop
    Call hanik2
    
    If gyou = 3 Then
      gyou = 4
    End If
    With Range(Cells(4, 1), Cells(gyou + 1, retu))
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
      .Borders(xlEdgeRight).LineStyle = xlContinuous
      .Borders(xlEdgeLeft).LineStyle = xlContinuous
      .Borders(xlEdgeBottom).LineStyle = xlContinuous
    End With
    Range(Cells(4, 1), Cells(gyou + 1, 3)).Borders.LineStyle = xlContinuous
    For g = 3 To gyou Step 5
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlMedium
    Next r
    Next g
    For g = 3 To gyou Step 10
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlThick
            'Cells(g, r).Borders(xlEdgeBottom).ColorIndex = 45
    Next r
    Next g
    Call tannin
    Range("b4").Select
End Sub

＊シート「gm5」に実行するボタンのマクロを変更する。
・ボタン内の表示を「２ここをクリックし実行」のマクロ登録を「クラス５」する。
・シート「gm5」の学年、組を記入し、「２ここをクリックし実行」のボタンを押す。
これで、そのクラスの名前が表示さきれば、練習問題４の完成です。時間は３０分でできれば合格です。

２４ 練習問題３ 学級記録用漢字とひらがな名簿の作成

問題　上記の写真のように、２２番で作成したものにひらがなも表示するシートを作成します。

解答
＊学級記録用漢字とひらなが名簿のシートを作成する。
・シート「gm2」をコピーして、できたシートの名前を「gm4」とする。
＊「窓口」シートに「漢字ひらがな」ボタンを作成する。
・ボタン「漢字ひらがな」をダブルクリックをし、コードウインドウを開き次のような命令文を書く。

Private Sub CommandButton3_Click()
    Worksheets("gm4").Activate
    Worksheets("gm4").Range("B2").Select
End Sub

＊シート「gm4」に表示したいデータや枠を書き換える。

・Module３に「クラス４」のマクロを下記のように書く。

Sub クラス4()
    Call hanik2
    If gyou = 3 Then
      gyou = 4
    End If
     Range(Cells(4, 1), Cells(gyou, retu)).Value = ""
     Call 罫線を消す
     Range("a4").Select
     g = 4
        Do Until Worksheets("表１").Cells(g, "f").Value = ""
           With ActiveCell
            If Worksheets("表１").Cells(g, "c").Value = _
            Cells(2, "e") And _
            Worksheets("表１").Cells(g, "d").Value = _
            Cells(2, "g") Then
            .Value = Worksheets("表１").Cells(g, "e").Value
            .Offset(0, 1).Value = Worksheets("表１").Cells(g, "f").Value
            .Offset(0, 2).Value = Worksheets("表１").Cells(g, "g").Value
            .Offset(1, 0).Select
            End If
            g = g + 1
           End With
        Loop
    Call hanik2
    Call 罫線を引く
    Call tannin
    Range("b4").Select
End Sub

＊シート「gm4」に実行するボタンのマクロを変更する。
・ボタン内の表示を「２ここをクリックし実行」のマクロ登録を「クラス４」する。
・シート「gm4」の学年、組を記入し、「２ここをクリックし実行」のボタンを押す。
これで、そのクラスの名前が表示さきれば、練習問題３の合格です。

訂正 罫線に関するマクロ

訂正
「できる大辞典Excl VBA」P２４８を参考にして、罫線についてのマクロを作りました。しかし、もっと簡単にできたので直します。他のマクロも変更しておくといいと思います。どいんな違いがあるのか現在の所、分かりません。

Sub 罫線を引く()
    Range(Cells(4, 1), Cells(gyou + 1, retu)).Select
    Selection.Borders.LineStyle = xlContinuous
    For g = 3 To gyou Step 5
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlMedium
    Next r
    Next g
    For g = 3 To gyou Step 10
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlThick
            'Cells(g, r).Borders(xlEdgeBottom).ColorIndex = 45
    Next r
    Next g
End Sub

↓

Sub 罫線を引く()
    Range(Cells(4, 1), Cells(gyou + 1, retu)).Borders.LineStyle = xlContinuous
    For g = 3 To gyou Step 5
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlMedium
    Next r
    Next g
    For g = 3 To gyou Step 10
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlThick
            'Cells(g, r).Borders(xlEdgeBottom).ColorIndex = 45
    Next r
    Next g
End Sub

Sub 罫線を消す()
    Range(Cells(4, 1), Cells(gyou + 1, retu)).Select
    Selection.Borders.LineStyle = xlNone
End Sub

↓

Sub 罫線を消す()
    Range(Cells(4, 1), Cells(gyou + 1, retu)).Borders.LineStyle = xlNone
End Sub

２３ 学級記録用文の作成

２２では、記号の記録に適した表であったのですが、文を入力する表を作成をします。
たくさんの作業がなされている様ですが、今までの繰り返しがほとんどで、僅かな手直しで終わっています。
＊学級記録用文のシートを作成する。
・シート「gm2」をコピーして、できたシートの名前を「gm3」とする。
＊「窓口」シートに「学級記録用文」ボタンを作成する。
・ボタン「学級記録用文」をダブルクリックをし、コードウインドウを開き次のような命令文を書く。

Private Sub CommandButton4_Click()
    Worksheets("gm3").Activate
    Worksheets("gm3").Range("B2").Select
End Sub

・Module３に「クラス３」のマクロを下記のように書く。

Sub クラス3()
    Call hanik2
    If gyou = 3 Then
      gyou = 4
    End If
     Range(Cells(4, 1), Cells(gyou, retu)).Value = ""
     Call 罫線を消す
     Range("a4").Select
     g = 4
        Do Until Worksheets("表１").Cells(g, "f").Value = ""
           With ActiveCell
            If Worksheets("表１").Cells(g, "c").Value = _
            Cells(2, "e") And _
            Worksheets("表１").Cells(g, "d").Value = _
            Cells(2, "g") Then
            .Value = Worksheets("表１").Cells(g, "e").Value
            .Offset(0, 1).Value = Worksheets("表１").Cells(g, "f").Value
            .Offset(1, 0).Select
            End If
            g = g + 1
           End With
        Loop
    Call hanik2
    Range(Cells(4, 1), Cells(gyou + 1, retu)).Select
    With Selection
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
      .Borders(xlEdgeRight).LineStyle = xlContinuous
      .Borders(xlEdgeLeft).LineStyle = xlContinuous
      .Borders(xlEdgeBottom).LineStyle = xlContinuous
    End With
    Range(Cells(4, 1), Cells(gyou + 1, 2)).Select
    Selection.Borders.LineStyle = xlContinuous
    For g = 3 To gyou Step 5
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlMedium
    Next r
    Next g
    For g = 3 To gyou Step 10
    For r = 1 To retu
            Cells(g, r).Borders(xlEdgeBottom).Weight = xlThick
            'Cells(g, r).Borders(xlEdgeBottom).ColorIndex = 45
    Next r
    Next g
    Call tannin
    Range("b4").Select
End Sub

＊シート「gm3」に実行するボタンを作成する。
・ボタン内の表示を「２ここをクリックし実行」のマクロ登録を「クラス３」する。
・シート「gm2」の学年、組を記入し、「２ここをクリックし実行」のボタンを押す。
これで、そのクラスの名前が表示さきれば、２３（２）の成功です。

訂正

Sub 罫線を消す()
    Range(Cells(4, 1), Cells(gyou + 1, retu)).Select
    Selection.Borders.LineStyle = xlNone
End Sub

Cells(4, 1)がCells(3, 1)になっていました。２３番では４に直さないとうまくいきません。

２２（２） 学級記録用名簿の作成

Module３に「クラス２」のマクロを書きのように書く。

Sub クラス2()
    Call hanik2
    If gyou = 3 Then
      gyou = 4
    End If
     Range(Cells(4, 1), Cells(gyou, retu)).Value = ""
     Call 罫線を消す
     Range("a4").Select
     g = 4
        Do Until Worksheets("表１").Cells(g, "f").Value = ""
           With ActiveCell
            If Worksheets("表１").Cells(g, "c").Value = _
            Cells(2, "e") And _
            Worksheets("表１").Cells(g, "d").Value = _
            Cells(2, "g") Then
            .Value = Worksheets("表１").Cells(g, "e").Value
            .Offset(0, 1).Value = Worksheets("表１").Cells(g, "f").Value
            .Offset(1, 0).Select
            End If
            g = g + 1
           End With
        Loop
    Call hanik2
    Call 罫線を引く
    Call tannin
    Range("b4").Select
End Sub

＊シート「gm1」に実行するボタンを作成する。
・ボタン内の表示を「２ここをクリックし実行」のマクロ登録を「クラス２」する。
・シート「gm2」の学年、組を記入し、「２ここをクリックし実行」のボタンを押す。
これで、そのクラスの名前が表示さきれば、２２（２）の成功です。

にほんブログ村 PC家電ブログ Windowsへ(文字をクリック)