受講生 さん:

こんばんは。

> また、PrintSet, Keisenでもなるたけ対象シートを指定、w.Rangeとか wm1.Rangeとしましたが、エラーになります。とりあえず、activateを入れると走るのでそうしてますが、せっかく明確にシートを指定したのに（VBAが誤解しにくいはず）、逆効果でエラーになるのか、首をひねっています。これもご解説いただけたら幸いです。

↑
これについては、エラーになる（けど、なっとくいかない）状態のマクロをお送りください。

添削は、それをいただいてから、と思います。

よろしくお願いします。


> 小川先生　
> 丁寧な添削いただきありがとうございました。再度、手直ししましたので、ご覧ください。
> さて、CreateDenpyoで、左辺に転出先のシートの指定を入れる件ですが、いまいちすっきりした形にできませんでした。なんか長ったらしいいので、スマートにまとめれれば、と思っております。
> また、PrintSet, Keisenでもなるたけ対象シートを指定、w.Rangeとか wm1.Rangeとしましたが、エラーになります。とりあえず、activateを入れると走るのでそうしてますが、せっかく明確にシートを指定したのに（VBAが誤解しにくいはず）、逆効果でエラーになるのか、首をひねっています。これもご解説いただけたら幸いです。
> よろしくお願いします。

2018/03/09 05:27

小川先生　activeateなしでエラーになるversion添付しました。よろしくお願いします。

2018/03/12 05:37

松井　 憲明さん:

拝見しました。
セルをアクティブに、またはセレクトするには、事前にその含まれるシートをアクティブにする必要があります。

以下、添削です。

Option Explicit
'ここまで作り込んだのであればソース内のよけいな空白行は極力潰して、可読性をより高めたいすね。 ogawa
Dim sColSort As String '小川追加。 ogawa
Sub numbering()
'putting ID numbers

    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
            
    
    
    With ActiveWorkbook.Worksheets("main").Sort
        .SortFields.Clear
'        .SortFields.Add Key:=Range("B2:B" & bot), _
'        Order:=xlAscending
        .SortFields.Add Key:=Range("B2:B" & bot), Order:=xlAscending '←このくらいなら１行でいいかも。 ogawa
        .SetRange Range("A1:G" & bot)
        .Header = xlYes
        
        .Apply
    End With

        
    

End Sub

Sub sortA()

    '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
            
   
    
    With ActiveWorkbook.Worksheets("main").Sort
        .SortFields.Clear
'        .SortFields.Add Key:=Range("A2:A" & bot), _
'        Order:=xlAscending
        .SortFields.Add Key:=Range("A2:A" & bot), Order:=xlAscending '←このくらいなら１行でいいかも。 ogawa
        .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
    Dim ln As Long            'adding aline in a distination sheet
    Dim stv As Long         ' sotre the cumulative value of the invoice amounts
    Dim wd As Worksheet  ' destinatnion sheet
    
    Set wm = Worksheets("main")
    Set wm1 = Worksheets("main1")
    
'    DeleteSheets '小川案でいくならこのタイミングでの呼び出しは不要。 ogawa
    bot = wm.Range("B" & Excel.Rows.Count).End(xlUp).Row
    
    For gyo = 2 To bot
        If wm.Range("B" & gyo).Value <> wm.Range("B" & gyo - 1).Value Then
            wm1.Copy after:=Sheets(2)  'make a copy
            ActiveSheet.Name = wm.Range("B" & gyo).Value
            Set wd = Worksheets(wm.Range("B" & gyo).Value) 'Added newly to store the destination sheet into wd
            ln = 16
            stv = 0
        End If
        stv = stv + wm.Range("G" & gyo)
        wd.Range("E" & ln) = wm.Range("B" & gyo)     'move each line from the main sheet to a corresponding destination sheet
        wd.Range("f" & ln) = wm.Range("e" & gyo)    'wd was put in front to clarify the destinatnion sheet which the code works on
        wd.Range("b" & ln) = Format(wm.Range("c" & gyo), "yy") 'Format function was tried out in these three lines per Mr Ogawa's suggestion
        wd.Range("c" & ln) = Format(wm.Range("c" & gyo), "mm")
        wd.Range("d" & ln) = Format(wm.Range("c" & gyo), "dd")
        wd.Range("k" & ln) = stv
            
        If wm.Range("G" & gyo) < 0 Then 'distingush negatives from positives
            wd.Range("i" & ln) = wm.Range("G" & gyo)
        Else
            wd.Range("j" & ln) = wm.Range("G" & gyo)
        End If
        ln = ln + 1
        'keisen      'NOT A GOOD OPTION - adding "Keisen" immediately after the completion of a destinatnion sheet
    Next gyo
    
    

End Sub


Sub DeleteSheets()
    
    Dim w As Worksheet
        
    Application.DisplayAlerts = False
    
    For Each w In Worksheets
        Select Case w.Name   'used select case clause instead of If clause
            Case "main", "main1", "mainButton"
            Case Else
                w.Delete
        End Select
        
    Next
    Application.DisplayAlerts = True
    
End Sub


Sub keisen()
        
    Dim w As Worksheet
    
'    Application.ScreenUpdating = False '←末尾に =true とセットで入れたいところ。
                                        '画面のチラつき防止だけでなく、高速化にも寄与します。 ogawa
    For Each w In Worksheets
        If Left(w.Name, 4) <> "main" Then
            'adding border lines
            Dim bot As Long
                     ' w.Activate WAS REMOVED PURPOSEFULLY  TO CAUSE AN ERROR
            bot = w.Range("B" & Excel.Rows.Count).End(xlUp).Row
        
            w.Activate 'need to acitvate the worksheet including the range you want to select. ogawa
'            w.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
'            w.Range("B16:B" & bot & ",H16:H" & bot & ",K16:K" & bot & ",J16:J" & bot & ",I16:I" & bot & ",F16:F" & bot & ",E16:E" & bot & "").Select
            
            With w.Range("B16:K" & bot)
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                
                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
                
                '以下は、内部の軽線引き。 ogawa
                With .Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
                With .Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                End With
            End With
        End If
        
            
    Next
'    Application.ScreenUpdating = True
    
        

        
            
        
        
        
            
End Sub

Sub PrintSet()
    '以下の設定は何もマクロで書く必要はありません。
    'エクセルのリボンから「ページレイアウト」→「ページ設定ダイアログ」で
    '（マクロ自動記録の作業すらなしで）ただ設定しておけばOKです。
    'テンプレも少しいじりました。 sub keisen... 内での処理をより簡潔に書くためです。
    'シート「main1_matsuisan」をテンプレとした場合と、仕上がりを比べてください。 ogawa

    'Print format is set to main1 sheet before it is dulpicated into new sheets
    Dim bot As Long
    Dim wm1 As Worksheet

    Set wm1 = Worksheets("main1")
              'wm1.Activate WAS REMOVED PURPOSDFULLY FOR AN ERROR TO SHOW
    bot = wm1.Range("B" & Excel.Rows.Count).End(xlUp).Row ' getting the bottom line
    Dim prg As Range
    Set prg = wm1.Range("A1:K" & bot)
    
    wm1.Activate 'need to acitvate the worksheet including the range you want to select. ogawa
    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()
    'そうそう。この演習では、シート作成実行ボタン、シート削除ボタンも作りますが、
    '(せっかくなので、 mainButton シート内にあるボタンももうちょい丁寧に作ってみましょう (^^; ogawa
    numbering
    sortB
'    PrintSet'当該プロシージャ先頭に記載のコメントご確認ください。 ogawa
    CreateDenpyo
    keisen
    sortA

End Sub

'↓モジュールレベル変数を使った共通化例。参考までに。 ogawa
Sub AllTogether_ogawa()
    DeleteSheets '←僕ならこのタイミングでやります。「初期化」は、作業開始前に行うべき。 ogawa
    numbering
    
    sColSort = "B"
    sortOgawa
'    PrintSet'当該プロシージャ先頭に記載のコメントご確認ください。 ogawa
    CreateDenpyo
    keisen
    
    sColSort = "A"
    sortOgawa
End Sub

'↓AllTogether_ogawa で呼び出されるもの。 ogawa
Sub sortOgawa()

    Dim bot As Long
    Dim wm As Worksheet
    
    Set wm = Worksheets("main")
    wm.Activate
    bot = wm.Range("B" & Excel.Rows.Count).End(xlUp).Row
    With ActiveWorkbook.Worksheets("main").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(sColSort & "2:" & sColSort & bot), Order:=xlAscending  '←参考にしてください ogawa
        .SetRange Range("A1:G" & bot)
        .Header = xlYes
        .Apply
    End With
End Sub

2018/03/12 18:08