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

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

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

受講生さんの投稿

(投稿ID: 4192)

小川様

添削ありがとうございました。リライトいたしました。再度、添削をお願いいたします。

Sub ikkini()
    sort1
    hontai
    sort2
End Sub

Sub sort1()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
    Worksheets("main").Range("A1").Value = "No."
    Worksheets("main").Range("A2").Value = 1
    Worksheets("main").Range("A2").AutoFill Destination:=Range("A2:A" & cSaigo), Type:=xlLinearTrend
End Sub

Sub sort2()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Range("A2:A" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
End Sub

Sub syokyo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        If ws.Name = "main" Or ws.Name = "main1" Then
        Else
            ws.Delete
        End If
        Application.DisplayAlerts = True
    Next
End Sub

Sub hontai()
    syokyo
    Dim cGyo As Long
    Dim cSaigo As Long
    Dim wsMain As Worksheet
    Dim wsNow As Worksheet
    Dim sGyosya As String
    Dim dDate As Date
    Dim cSaki As Long
    Set wsMain = Worksheets("main")
    cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
    For cGyo = 2 To cSaigo
        If sGyosya <> wsMain.Range("B" & cGyo).Value Then
            If cGyo > 2 Then
                keisen
            End If
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
            Set wsNow = ActiveSheet
            sGyosya = wsNow.Name
            cSaki = 16
        End If
        wsNow.Range("F2").Value = wsNow.Name
        wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
        wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
        wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
        dDate = wsMain.Range("C" & cGyo).Value
        wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
        wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
        wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
        If wsMain.Range("G" & cGyo) > 0 Then
            wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        ElseIf wsMain.Range("G" & cGyo) < 0 Then
            wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        End If
        If cSaki = 16 Then
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
        Else
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
        End If
        cSaki = cSaki + 1
    Next
    keisen
End Sub

Sub keisen()
    Dim cSaigo As Long
    Dim wsNow As Worksheet
    Set wsNow = ActiveSheet
    cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
    Range("B16:K" & cSaigo).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B16:K" & cSaigo).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B16:K" & cSaigo).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End Sub

2018/10/03 14:06

小川慶一さんのコメント

(コメントID: 5750)

受講生さん:

添削を返送します。

Option Explicit

Sub ikkini()
    sort1
    hontai
    sort2
End Sub

Sub sort1()
    '↓シート「main」がアクティブな状態からのスタートでないと[*]エラーで止まります。以下の１行を加えるか、シート「main」上にボタンをつけ、そこからマクロを実行させるよう誘導するべき
    Worksheets("main").Activate
    
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
    Worksheets("main").Range("A1").Value = "No."
    Worksheets("main").Range("A2").Value = 1
    Worksheets("main").Range("A2").AutoFill Destination:=Range("A2:A" & cSaigo), Type:=xlLinearTrend '[*]
End Sub

Sub sort2()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Range("A2:A" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
End Sub


Sub syokyo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        'Elseなしで表現してください
        If ws.Name = "main" Or ws.Name = "main1" Then
        Else
            ws.Delete
        End If
        Application.DisplayAlerts = True
    Next
End Sub

Sub hontai()
    syokyo
    Dim cGyo As Long
    Dim cSaigo As Long
    Dim wsMain As Worksheet
    Dim wsNow As Worksheet
    Dim sGyosya As String
    Dim dDate As Date
    Dim cSaki As Long
    Set wsMain = Worksheets("main")
    cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
    For cGyo = 2 To cSaigo
        If sGyosya <> wsMain.Range("B" & cGyo).Value Then
            If cGyo > 2 Then
                keisen
            End If
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
            Set wsNow = ActiveSheet
            sGyosya = wsNow.Name
            cSaki = 16
        End If
        wsNow.Range("F2").Value = wsNow.Name
        wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
        wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
        wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
        dDate = wsMain.Range("C" & cGyo).Value
        wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
        wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
        wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
        If wsMain.Range("G" & cGyo) > 0 Then
            wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        ElseIf wsMain.Range("G" & cGyo) < 0 Then
            wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        End If
        If cSaki = 16 Then
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
        Else
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
        End If
        cSaki = cSaki + 1
    Next
    keisen
End Sub

Sub keisen()
    Dim cSaigo As Long
    Dim wsNow As Worksheet
    Set wsNow = ActiveSheet
    cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
'    Range("B16:K" & cSaigo).Borders(xlDiagonalDown).LineStyle = xlNone
'    Range("B16:K" & cSaigo).Borders(xlDiagonalUp).LineStyle = xlNone
'    With Range("B16:K" & cSaigo).Borders(xlEdgeLeft)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'    End With
'    With Range("B16:K" & cSaigo).Borders(xlEdgeTop)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'    End With
'    With Range("B16:K" & cSaigo).Borders(xlEdgeBottom)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'    End With
'    With Range("B16:K" & cSaigo).Borders(xlEdgeRight)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'    End With
'    With Range("B16:K" & cSaigo).Borders(xlInsideVertical)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'    End With
'    With Range("B16:K" & cSaigo).Borders(xlInsideHorizontal)
'        .LineStyle = xlContinuous
'        .Weight = xlThin
'    End With

    '↓[1]直前の行までの様子からするに、こう書くべきですね。
    wsNow.Range("B16:K" & cSaigo).Borders(xlDiagonalDown).LineStyle = xlNone
    wsNow.Range("B16:K" & cSaigo).Borders(xlDiagonalUp).LineStyle = xlNone
    With wsNow.Range("B16:K" & cSaigo).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With wsNow.Range("B16:K" & cSaigo).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With wsNow.Range("B16:K" & cSaigo).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With wsNow.Range("B16:K" & cSaigo).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With wsNow.Range("B16:K" & cSaigo).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With wsNow.Range("B16:K" & cSaigo).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

    '↓[2]冗長さを避けるなら、さらに、以下まで手直し
    With wsNow.Range("B16:K" & cSaigo)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With
End Sub

> 小川様
>
> 添削ありがとうございました。リライトいたしました。再度、添削をお願いいたします。
>
>

Sub ikkini()
>     sort1
>     hontai
>     sort2
> End Sub

>
>

Sub sort1()
>     Dim cSaigo As Long
>     cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
>     Worksheets("main").Sort.SortFields.Clear
>     Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B" & cSaigo), _
>         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
>     With Worksheets("main").Sort
>         .SetRange Range("A1:G" & cSaigo)
>         .Header = xlYes
>         .Apply
>     End With
>     Worksheets("main").Range("A1").Value = "No."
>     Worksheets("main").Range("A2").Value = 1
>     Worksheets("main").Range("A2").AutoFill Destination:=Range("A2:A" & cSaigo), Type:=xlLinearTrend
> End Sub

>
>

Sub sort2()
>     Dim cSaigo As Long
>     cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
>     Worksheets("main").Sort.SortFields.Clear
>     Worksheets("main").Sort.SortFields.Add Key:=Range("A2:A" & cSaigo), _
>         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
>     With Worksheets("main").Sort
>         .SetRange Range("A1:G" & cSaigo)
>         .Header = xlYes
>         .Apply
>     End With
> End Sub

>
>
>

Sub syokyo()
>     Dim ws As Worksheet
>     For Each ws In Worksheets
>         Application.DisplayAlerts = False
>         If ws.Name = "main" Or ws.Name = "main1" Then
>         Else
>             ws.Delete
>         End If
>         Application.DisplayAlerts = True
>     Next
> End Sub

>
>

Sub hontai()
>     syokyo
>     Dim cGyo As Long
>     Dim cSaigo As Long
>     Dim wsMain As Worksheet
>     Dim wsNow As Worksheet
>     Dim sGyosya As String
>     Dim dDate As Date
>     Dim cSaki As Long
>     Set wsMain = Worksheets("main")
>     cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
>     For cGyo = 2 To cSaigo
>         If sGyosya <> wsMain.Range("B" & cGyo).Value Then
>             If cGyo > 2 Then
>                 keisen
>             End If
>             Sheets("main1").Copy After:=Sheets(Worksheets.Count)
>             Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
>             Set wsNow = ActiveSheet
>             sGyosya = wsNow.Name
>             cSaki = 16
>         End If
>         wsNow.Range("F2").Value = wsNow.Name
>         wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
>         wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
>         wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
>         dDate = wsMain.Range("C" & cGyo).Value
>         wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
>         wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
>         wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
>         If wsMain.Range("G" & cGyo) > 0 Then
>             wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
>         ElseIf wsMain.Range("G" & cGyo) < 0 Then
>             wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
>         End If
>         If cSaki = 16 Then
>             wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
>         Else
>             wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
>         End If
>         cSaki = cSaki + 1
>     Next
>     keisen
> End Sub

>
>

Sub keisen()
>     Dim cSaigo As Long
>     Dim wsNow As Worksheet
>     Set wsNow = ActiveSheet
>     cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
>     Range("B16:K" & cSaigo).Borders(xlDiagonalDown).LineStyle = xlNone
>     Range("B16:K" & cSaigo).Borders(xlDiagonalUp).LineStyle = xlNone
>     With Range("B16:K" & cSaigo).Borders(xlEdgeLeft)
>         .LineStyle = xlContinuous
>         .Weight = xlThin
>     End With
>     With Range("B16:K" & cSaigo).Borders(xlEdgeTop)
>         .LineStyle = xlContinuous
>         .Weight = xlThin
>     End With
>     With Range("B16:K" & cSaigo).Borders(xlEdgeBottom)
>         .LineStyle = xlContinuous
>         .Weight = xlThin
>     End With
>     With Range("B16:K" & cSaigo).Borders(xlEdgeRight)
>         .LineStyle = xlContinuous
>         .Weight = xlThin
>     End With
>     With Range("B16:K" & cSaigo).Borders(xlInsideVertical)
>         .LineStyle = xlContinuous
>         .Weight = xlThin
>     End With
>     With Range("B16:K" & cSaigo).Borders(xlInsideHorizontal)
>         .LineStyle = xlContinuous
>         .Weight = xlThin
>     End With
> End Sub

2018/10/03 15:13