エクセルマクロ オンライン講座コメント紹介

コメント紹介
   └ 発展編1 フォローメールセミナー
       └ 発展編1 フォローメールセミナー 第9回

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

[10629] 2018-10-04 04:53:28 わかやまさんからの投稿です。

小川様

再度、手直しいたしました。添削、どうぞよろしくお願いします。

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:=Worksheets("main").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:=Worksheets("main").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:=Worksheets("main").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 Left(ws.Name, 4) <> "main" Then 'Left関数を用いました!
            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
                keisen2
            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
    keisen2
End Sub


Sub keisen2() 'ネットで調べ、シンプルにしました。同じ動作にはなっております。
    Dim cSaigo As Long
    Dim wsNow As Worksheet
    Set wsNow = ActiveSheet
    cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
    wsNow.Range("B16:K" & cSaigo).Borders.LineStyle = xlContinuous
End Sub

 


[10638] 2018-10-10 11:18:13 小川慶一さんからの投稿です。

わかやまさん:

その後投稿いただいた第13回のメールセミナーへのフィードバック同様、特に問題ありません。

手直しするだけでなく、イチから書き直されることをおすすめします。



> 小川様
>
> 再度、手直しいたしました。添削、どうぞよろしくお願いします。
>
>
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:=Worksheets("main").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:=Worksheets("main").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:=Worksheets("main").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 Left(ws.Name, 4) <> "main" Then 'Left関数を用いました!
>             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
>                 keisen2
>             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
>     keisen2
> End Sub

>
>
Sub keisen2() 'ネットで調べ、シンプルにしました。同じ動作にはなっております。
>     Dim cSaigo As Long
>     Dim wsNow As Worksheet
>     Set wsNow = ActiveSheet
>     cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
>     wsNow.Range("B16:K" & cSaigo).Borders.LineStyle = xlContinuous
> End Sub

>

 


[10642] 2018-10-10 11:37:33 わかやまさんからの投稿です。

小川様

ありがとうございます。
同じようなコードを用いて、仕事で実践しています。
よりよいものができるように工夫していきます。

 


[10647] 2018-10-11 07:18:21 小川慶一さんからの投稿です。

わかやまさん:

この問題で紹介しているパターンは、使いこなせるようになると、実務での応用範囲が広いです。


> 小川様
>
> ありがとうございます。
> 同じようなコードを用いて、仕事で実践しています。
> よりよいものができるように工夫していきます。
>

 


まずはここから!スマホでも学べる無料動画講座

今なら先着30名限定で無料!定価4,800円の、初心者のためのエクセルマクロ動画講座。
  1. Excel 97~Excel 2016まですべて対応。動画本数20本、総再生時間2時間44分53秒
  2. PC, Mac, iPhone, iPad, Androidのお好みの環境で、いつでも好きなときに学べます。
2004年から10年間述べ3,000名以上に実施した研修の経験と実績を集約した講座です。
いますぐ無料で試してください。

トップへ