投稿/コメントを表示します。

【宿題】お世話になります。課題を提出致します。
添削宜しくお願い致します。
Option Explicit
    Public Moto As Worksheet
    Public Saki As Worksheet
    Public saigo As Long
    Public gyo As Long
    Public Tenki As Worksheet
Sub denpyosakusei()
    Dim hiduke As Date
    Dim kakidasi As Long
    Dim kingaku As Long
    Dim zandaka As Long
    
    Set Saki = Workbooks("s09_homework").Worksheets("main1")
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    denpyosyokyo
    
    '作成前のシート"main"の並べ替え
    id
    hiduke_narabe
    b_narabe
    
    'シート作成&転記
    For gyo = 2 To saigo
        If Moto.Range("B" & gyo).Value <> Moto.Range("B" & gyo - 1).Value Then
            kakidasi = 16
            zandaka = 0
            Saki.Copy After:=Sheets(Worksheets.Count)
            Set Tenki = ActiveSheet
            Tenki.Name = Moto.Range("B" & gyo).Value
        End If
        hiduke = Moto.Range("C" & gyo).Value
        kingaku = Moto.Range("G" & gyo).Value
        Tenki.Range("B" & kakidasi).Value = Right(Year(hiduke), 2)
        Tenki.Range("C" & kakidasi).Value = Month(hiduke)
        Tenki.Range("D" & kakidasi).Value = Day(hiduke)
        Tenki.Range("E" & kakidasi & ":F" & kakidasi).Value = Moto.Range("D" & gyo & ":E" & gyo).Value
        Tenki.Range("H" & kakidasi).Value = Moto.Range("F" & gyo).Value
        Select Case kingaku
            Case Is >= 0
                Tenki.Range("I" & kakidasi).Value = kingaku
            Case Else
                Tenki.Range("J" & kakidasi).Value = kingaku
        End Select
        zandaka = zandaka + kingaku
        Tenki.Range("K" & kakidasi).Value = zandaka
        
        '掛線
        If Moto.Range("B" & gyo).Value <> Moto.Range("B" & gyo + 1).Value Then
            With Tenki.Range("B16" & ":K" & kakidasi)
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlThin
            End With
            If zandaka < 0 Then  '最終残高がマイナスの時、タブの色を赤にするアレンジ
                Tenki.Tab.Color = vbRed
            End If
        End If
        kakidasi = kakidasi + 1
    Next
    
    Moto.Select 'シート"main"を元に戻す
    id_narabe
    Moto.Columns("A:A").ClearContents
End Sub
Sub id()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Range("A1").Value = "No."
    For gyo = 2 To saigo
        Moto.Range("A" & gyo).Value = gyo - 1
    Next
End Sub
Sub b_narabe()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Sort.SortFields.Clear
    Moto.Sort.SortFields.Add Key:=Range("B2:B" & saigo)
    With Moto.Sort
        .SetRange Range("A1:G" & saigo)
        .Header = xlYes
        .Apply
    End With

End Sub
Sub id_narabe()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Sort.SortFields.Clear
    Moto.Sort.SortFields.Add Key:=Range("A2:A" & saigo)
    With Moto.Sort
        .SetRange Range("A1:G" & saigo)
        .Header = xlYes
        .Apply
    End With

End Sub
Sub hiduke_narabe()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Sort.SortFields.Clear
    Moto.Sort.SortFields.Add Key:=Range("C2:C" & saigo)
    With Moto.Sort
        .SetRange Range("A1:G" & saigo)
        .Header = xlYes
        .Apply
    End With

End Sub

Sub denpyosyokyo()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If InStr(ws.Name, "main") = 0 Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

2020/11/22 20:02