レッスン-投稿一覧パソコン仕事５倍塾ポータル

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

発展編1 フォローメールセミナー

受講生さんの投稿

(投稿ID: 5004)

提出いたします。

Option Explicit
Dim S_main As Worksheet
Dim S_hina As Worksheet
Dim saigo As Long
Sub zentai()
Set S_main = Worksheets("main")
Set S_hina = Worksheets("main1")
saigo = S_main.Range("B65536").End(xlUp).Row
anum
bnara
fuyokeshi
tenki '中にkeisen
anara
End Sub
Sub anum()
Dim n As Long
For n = 2 To saigo
S_main.Range("A" & n).Value = n - 1
Next
End Sub

Sub bnara()
Range("A1:G317").Sort _
key1:=Range("B1"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub

Sub anara()
Range("A1:G317").Sort _
key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub
Sub fuyokeshi()
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, 4) <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub tenki()
Dim mgyo As Long
Dim mtori As String
Dim S_copy As Worksheet
Dim copygyo
Dim dt As Date
For mgyo = 2 To saigo
mtori = S_main.Range("B" & mgyo).Value
If mtori <> S_main.Range("B" & mgyo - 1).Value Then
If mgyo > 2 Then
keisen
End If
copygyo = 16
S_hina.Copy after:=Sheets(2)
Set S_copy = ActiveSheet
S_copy.Name = mtori
End If
S_copy.Range("E" & copygyo).Value = S_main.Range("D" & mgyo).Value
S_copy.Range("F" & copygyo).Value = S_main.Range("E" & mgyo).Value
S_copy.Range("H" & copygyo).Value = S_main.Range("F" & mgyo).Value
dt = S_main.Range("C" & mgyo).Value
S_copy.Range("B" & copygyo).Value = Right(Year(dt), 2)
S_copy.Range("C" & copygyo).Value = Month(dt)
S_copy.Range("D" & copygyo).Value = Day(dt)
If S_main.Range("G" & mgyo).Value > 0 Then
S_copy.Range("J" & copygyo).Value = S_main.Range("G" & mgyo).Value
Else
S_copy.Range("I" & copygyo).Value = S_main.Range("G" & mgyo).Value
End If
If copygyo = 16 Then
S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value
Else
S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value + S_copy.Range("K" & copygyo - 1).Value
End If
copygyo = copygyo + 1
Next
keisen
S_main.Select
End Sub
Sub keisen()
Dim copysaigo As Long
copysaigo = Range("B65536").End(xlUp).Row
With Range("B16:K" & copysaigo)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Sub

2021/02/01 07:20

小川慶一さんのコメント

(コメントID: 7143)

受講生さん:

おはようございます。

とても良くかけていると思います。
ご自身の感想としてはどうでしょうか。

もう、この課題については自信を持たれているものと思います。
いかがでしょうか。

コード内で、インデントに関してコメントしました。2箇所です。
sub tenki 内はインデントを整えて再提出してください。
インデントを整えることは可読性を向上させます。可読性が向上すると、より複雑なマクロでも混乱なく読める＆書ける＆編集できるようになります。

インデントを整理するときの考え方のポイントは、「どのコードは、どのブロックの中の部品なのか？」ということを明確にすることです。
青い文字で対になっている言葉がありますね。
sub ... end sub, for ... next, if ... (else) ... end if 等。これらの中身は、「そのブロックの中の部品」なので、そうと識別しやすいように、一段右に移動させまず。

ひきつづき、学習お楽しみください (^^

Option Explicit
    '以下の3行はインデントしない。
    Dim S_main As Worksheet
    Dim S_hina As Worksheet
    Dim saigo As Long
Sub zentai()
    Set S_main = Worksheets("main")
    Set S_hina = Worksheets("main1")
    saigo = S_main.Range("B65536").End(xlUp).Row
    anum
    bnara
    fuyokeshi
    tenki '中にkeisen
    anara
End Sub
Sub anum()
    Dim n As Long
    For n = 2 To saigo
        S_main.Range("A" & n).Value = n - 1
    Next
End Sub

Sub bnara()
    Range("A1:G317").Sort _
        key1:=Range("B1"), _
        Order1:=xlAscending, _
        Header:=xlYes
End Sub

Sub anara()
    Range("A1:G317").Sort _
        key1:=Range("A1"), _
        Order1:=xlAscending, _
        Header:=xlYes
End Sub
Sub fuyokeshi()
    Application.DisplayAlerts = False
    Dim ws As Worksheet
    For Each ws In Worksheets
        If Left(ws.Name, 4) <> "main" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub
Sub tenki()
    Dim mgyo As Long
    Dim mtori As String
    Dim S_copy As Worksheet
    Dim copygyo
    Dim dt As Date
       For mgyo = 2 To saigo
    mtori = S_main.Range("B" & mgyo).Value
        If mtori <> S_main.Range("B" & mgyo - 1).Value Then
            If mgyo > 2 Then
                keisen
            End If
            copygyo = 16
            S_hina.Copy after:=Sheets(2)
            Set S_copy = ActiveSheet
            S_copy.Name = mtori
        End If
     S_copy.Range("E" & copygyo).Value = S_main.Range("D" & mgyo).Value
     S_copy.Range("F" & copygyo).Value = S_main.Range("E" & mgyo).Value
     S_copy.Range("H" & copygyo).Value = S_main.Range("F" & mgyo).Value
     dt = S_main.Range("C" & mgyo).Value
     S_copy.Range("B" & copygyo).Value = Right(Year(dt), 2)
     S_copy.Range("C" & copygyo).Value = Month(dt)
     S_copy.Range("D" & copygyo).Value = Day(dt)
     If S_main.Range("G" & mgyo).Value > 0 Then
        S_copy.Range("J" & copygyo).Value = S_main.Range("G" & mgyo).Value
     Else
        S_copy.Range("I" & copygyo).Value = S_main.Range("G" & mgyo).Value
     End If
     If copygyo = 16 Then
        S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value
     Else
        S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value + S_copy.Range("K" & copygyo - 1).Value
     End If
     copygyo = copygyo + 1
    Next
    keisen
    S_main.Select
End Sub
Sub keisen()
    Dim copysaigo As Long
    copysaigo = Range("B65536").End(xlUp).Row
    With Range("B16:K" & copysaigo)
    '以下の with 直下の2行はインデントする。
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    End With
End Sub

2021/02/01 16:40

受講生さんのコメント

(コメントID: 7145)

小川慶一さん:
ありがとうございます。遅れて申し訳ございません。

インデント整えて再提出致します。
Option Explicit

Dim S_main As Worksheet
Dim S_hina As Worksheet
Dim saigo As Long
Sub zentai()
Set S_main = Worksheets("main")
Set S_hina = Worksheets("main1")
saigo = S_main.Range("B65536").End(xlUp).Row
anum
bnara
fuyokeshi
tenki '中にkeisen
anara
End Sub
Sub anum()
Dim n As Long
For n = 2 To saigo
S_main.Range("A" & n).Value = n - 1
Next
End Sub

Sub bnara()
Range("A1:G317").Sort _
key1:=Range("B1"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub

Sub anara()
Range("A1:G317").Sort _
key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes
End Sub
Sub fuyokeshi()
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, 4) <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub tenki()
Dim mgyo As Long
Dim mtori As String
Dim S_copy As Worksheet
Dim copygyo
Dim dt As Date
For mgyo = 2 To saigo
mtori = S_main.Range("B" & mgyo).Value
If mtori <> S_main.Range("B" & mgyo - 1).Value Then
If mgyo > 2 Then
keisen
End If
copygyo = 16
S_hina.Copy after:=Sheets(2)
Set S_copy = ActiveSheet
S_copy.Name = mtori
End If
S_copy.Range("E" & copygyo).Value = S_main.Range("D" & mgyo).Value
S_copy.Range("F" & copygyo).Value = S_main.Range("E" & mgyo).Value
S_copy.Range("H" & copygyo).Value = S_main.Range("F" & mgyo).Value
dt = S_main.Range("C" & mgyo).Value
S_copy.Range("B" & copygyo).Value = Right(Year(dt), 2)
S_copy.Range("C" & copygyo).Value = Month(dt)
S_copy.Range("D" & copygyo).Value = Day(dt)
If S_main.Range("G" & mgyo).Value > 0 Then
S_copy.Range("J" & copygyo).Value = S_main.Range("G" & mgyo).Value
Else
S_copy.Range("I" & copygyo).Value = S_main.Range("G" & mgyo).Value
End If
If copygyo = 16 Then
S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value
Else
S_copy.Range("K" & copygyo).Value = S_main.Range("G" & mgyo).Value + S_copy.Range("K" & copygyo - 1).Value
End If
copygyo = copygyo + 1
Next
keisen
S_main.Select
End Sub
Sub keisen()
Dim copysaigo As Long
copysaigo = Range("B65536").End(xlUp).Row
With Range("B16:K" & copysaigo)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Sub

2021/02/07 01:02

小川慶一さんのコメント

(コメントID: 7146)

受講生さん:

おはようございます。

> インデント整えて再提出致します。

完璧です。

意識して行えばいろいろしっかりできるご様子ですので、そこは安心です。
今後とも、楽しんで学習を進めてください (^^*

2021/02/08 19:36