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

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

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

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

松井　憲明さんの投稿

(投稿ID: 3705) 添付ファイルのダウンロード権限がありません

小川先生　　整形してみました。再度、よろしくご覧ください。お願いいたします。

2018/03/06 16:20

小川慶一さんのコメント

(コメントID: 5219)

松井　憲明さん:

> 小川先生　　整形してみました。再度、よろしくご覧ください。お願いいたします。

インデントはかなり改善されましたね。改善前のプログラムと比較して、ご自身の感想はいかがですか。

添削の返送します。
直したいところはままありますが、全体によく書けています。

コメント参考にしてください。
そして、さらに書き直しての再提出をお願いします。

Option Explicit

Sub numbering()
'putting ID numbers

    'Good! ogwawa

    Dim gyo As Long
    Dim bot As Long  'bottomline
    Dim wm As Worksheet
    
    Set wm = Worksheets("main")
    bot = wm.Range("B" & Excel.Rows.Count).End(xlUp).Row
    
    For gyo = 2 To bot
        wm.Range("A" & gyo) = gyo - 1
    Next gyo
    wm.Range("a1").Value = "No"



End Sub


Sub sortB()

    ' sort by column B
    Dim bot As Long  'bottomline
    Dim wm As Worksheet
    
    Set wm = Worksheets("main")
    wm.Activate
    bot = wm.Range("B" & Excel.Rows.Count).End(xlUp).Row
    
    '以下3行、不要です。残した意図は？ ogawa
    wm.Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    wm.Range("A1:G" & bot).Select
    
    With ActiveWorkbook.Worksheets("main").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B2:B" & bot), _
        Order:=xlAscending
        .SetRange Range("A1:G" & bot)
        .Header = xlYes
        
        .Apply
    End With

    
    

End Sub

Sub sortA()
    'sortBとsortAは、並べ替え条件たる列が異なるだけです。
    'であれば、まったく同じ形になるはず...。
    'ということで、sortBでコメントしているので、ここでは重複した言及はしません。

    'sort by column A that is ID number

    Dim bot As Long  'bottomline
    Dim wm As Worksheet
    
    Set wm = Worksheets("main")
    wm.Activate
    bot = wm.Range("B" & Excel.Rows.Count).End(xlUp).Row
            
    wm.Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    wm.Range("A1:G" & bot).Select
    
    With ActiveWorkbook.Worksheets("main").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & bot), _
        Order:=xlAscending
        .SetRange Range("A1:G" & bot)
        .Header = xlYes
        
        .Apply
    End With

        
    



End Sub



Sub CreateDenpyo()
    'create a denpyo sheet for each company listed in the "main" sheet
    Dim bot As Long  'bottomline
    Dim wm As Worksheet
    Dim w As Worksheet
    Dim gyo As Long
    Dim wm1 As Worksheet
    '↓英単語1語の変数名は好ましくないです。知らないところで、エクセルやマクロの予約語である可能性大...。 ogawa
    Dim line As Long            'adding aline in a distination sheet
    Dim store As Long         ' sotre the cumulative value of the invoice amounts
    
    Set wm = Worksheets("main")
    Set wm1 = Worksheets("main1")
    
    DeleteSheets
    bot = wm.Range("B" & Excel.Rows.Count).End(xlUp).Row
    
    For gyo = 2 To bot
        'きちんとした条件判定！ v(^^* ogawa
        If wm.Range("B" & gyo).Value <> wm.Range("B" & gyo - 1).Value Then
            '↓以下3行、インデント多すぎです。
                '↓とはいえ、よく理解できています！ここに限らず、全体にそこはすばらしいです！
                wm1.Copy after:=Sheets(2)  'make a copy
                ActiveSheet.Name = wm.Range("B" & gyo).Value
                line = 16
                store = 0
        End If
        store = store + wm.Range("G" & gyo)
        '左辺でシートを指定していないものが多いですね。
        'このケースではたまたまOKでしたが、複数シート間での値の転記では、
        '転記先、転記元の両方でのセル指定はシートの指定から書くようにしましょう！
        'でないと、思わぬトラブルの元です。 ogawa
        Range("E" & line) = wm.Range("B" & gyo)     'move each line from the main sheet to a corresponding destination sheet
        Range("f" & line) = wm.Range("e" & gyo)
        '↓以下3行は、format関数を使う方法も調べてみてください。
        Range("b" & line) = Right(Year(wm.Range("c" & gyo)), 2)
        Range("c" & line) = Month(wm.Range("c" & gyo))
        Range("d" & line) = Day(wm.Range("c" & gyo))
        Range("k" & line) = store
            
        If wm.Range("G" & gyo) < 0 Then 'distingush negatives from positives
            '以下、インデント多すぎでした... ogawa
                Range("i" & line) = wm.Range("G" & gyo)
        Else
                Range("j" & line) = wm.Range("G" & gyo)
        End If
        line = line + 1
    Next gyo
    
    

End Sub


Sub DeleteSheets()
    'v(^_^* ogawa
    Dim bot As Long  'bottomline
    Dim wm As Worksheet
    Dim w As Worksheet
    Dim gyo As Long
    Dim wm1 As Worksheet
    
    '以下の2つも、 dim wm, dim wm1 も不要ですね。 gyo も不要。botも不要...
    '不要な変数はないか？等々、見直す習慣を！ ogawa
    Set wm = Worksheets("main")
    Set wm1 = Worksheets("main1")
    
    Application.DisplayAlerts = False
    
    For Each w In Worksheets
        If Left(w.Name, 4) <> "main" Then
            w.Delete
        End If
    Next
    Application.DisplayAlerts = True
    
End Sub


Sub keisen()

    'adding border lines
    Dim bot As Long
    bot = Range("B" & Excel.Rows.Count).End(xlUp).Row

    '↓以下の .select シリーズで意味あるのは（あえて言うなら）最後のだけですね。 ogawa
    Range("B16:B" & bot & ",H16:H" & bot).Select
    Range("B" & bot & ":B" & bot & ",H" & bot & ":H" & bot & ",K" & bot & ":K" & bot).Select
    Range("B" & bot & ":B" & bot & ",H" & bot & ":H" & bot & ",K" & bot & ":K" & bot & ",J" & bot & ":J" & bot & ",I" & bot & ":I" & bot & "").Select
    Range("B" & bot & ":B" & bot & ",H" & bot & ":H" & bot & ",K" & bot & ":K" & bot & ",J" & bot & ":J" & bot & ",I" & bot & ":I" & bot & ",F" & bot).Select
    Range("B16:B" & bot & ",H16:H" & bot & ",K16:K" & bot & ",J16:J" & bot & ",I16:I" & bot & ",F16:F" & bot & ",E16:E" & bot & "").Select
    
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
    Range("B16:K" & bot).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

        
End Sub

Sub PrintSet()
    '作成後の個別シートで設定するより、テンプレたる main1 を事前にいじったほうが楽で早いです。 ogawa
    
    Dim bot As Long
        
    bot = Range("B" & Excel.Rows.Count).End(xlUp).Row ' getting the bottom line
    Dim prg As Range
    Set prg = Range("A1:K" & bot)
    
    prg.Select
    ActiveSheet.PageSetup.PrintArea = prg
     
   With ActiveSheet.PageSetup
       .LeftHeader = "&F"
       .RightFooter = "&D&T"
       .LeftMargin = Application.InchesToPoints(0.78740157480315)
       .RightMargin = Application.InchesToPoints(0.78740157480315)
       .TopMargin = Application.InchesToPoints(0.984251968503937)
       .BottomMargin = Application.InchesToPoints(0.984251968503937)
       .HeaderMargin = Application.InchesToPoints(0.511811023622047)
       .FooterMargin = Application.InchesToPoints(0.511811023622047)

       .CenterHorizontally = True
       .Orientation = xlLandscape
       .PaperSize = xlPaperA4
       .FirstPageNumber = xlAutomatic
       .Order = xlDownThenOver
       .FitToPagesWide = 1
       .FitToPagesTall = 1

       .ScaleWithDocHeaderFooter = True
       
   End With


        
End Sub



Sub AllTogether()
    'ネーミングよいですね！ ogawa
    'ただし、納品物に問題が...。そこまできちんとチェックしてから納品してください。
    numbering
    sortB
    CreateDenpyo
    keisen   '←「宮崎繊維」以外のシートは罫線引かれませんね   (^^; ogawa
    PrintSet '←「宮崎繊維」以外のシートは書式設定されませんね (^^; ogawa
    sortA

End Sub

2018/03/07 08:41