オンライン講座 質問と回答

無料・有料のオンライン講座で寄せられたメッセージの一部を紹介致します。

[11591]発展編1 フォローメールセミナー 第18回

2019-09-13 18:34:48 ゲストさんからの投稿です。

小川先生

今まで指示語のような意味合いでしかselectionを捉えていなかったので、自動記録で作ったマクロを修正するときに、例えば、

range(“A2:A30”).select
with selection.~

のselectionを消してしまい、渋々また元に戻してみたり、何となくwith range(“A2:A29”).~ としてみたりを繰り返していました。Excelシート上で選択されたセル範囲を意味することを今回知ったことで、理解が深まりました(分からないと思った時点で、自分で調べておく必要があったのですが、やり過ごしてしまいました…)
実は現在転職活動中で、一つでも武器になるものを習得したいと思い、この講座を始めましたが、すぐに実践で使う機会もなかった為、学習の目的のきはくになりつつあり、最近は講座の進み具合も遅れがちでした。先生の「楽して結果を出したいから」いう考えにハッとしました。その為の準備だと思って、楽しみながら学んでいきたいです。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11491]発展編1 フォローメールセミナー 第11回

2019-07-01 14:38:26 小川慶一さんからの投稿です。

受講生の方から、添削依頼を受けました。
以下のものです。

Option Explicit
Dim wFm As Worksheet
Dim Ireru As String
Dim Mx As Long

Public Sub WsDelete()
    Dim wd As Worksheet
    Application.DisplayAlerts = False
    For Each wd In Worksheets
        If Left(wd.Name, 4) <> "main" Then
            wd.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Private Sub Bangou()
    wFm.Range("A2").FormulaR1C1 = "1"
    wFm.Range("A2:A317").DataSeries Rowcol:=xlColumns, _
    Type:=xlLinear, Date:=xlDay, _
    Step:=1, Trend:=False
End Sub

Private Sub Narabe()
    wFm.Sort.SortFields.Clear
    wFm.Sort.SortFields.Add Key:=wFm.Range(Ireru), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wFm.Sort
        .SetRange wFm.Range("A1:" & "G" & wFm.Range("G65536").End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
Private Sub Keisen()
    Mx = Range("K65536").End(xlUp).Row
    With Range("B16:K" & Mx)
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlHairline
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
    End With
End Sub
Private Sub P_hani()
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveWindow.View = xlNormalView
End Sub

Private Sub Daimei()
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup

        .CenterHeader = "&F"


        .CenterFooter = "&P / &N ページ"

        .LeftMargin = Application.InchesToPoints(0.748031496062992)
        .RightMargin = Application.InchesToPoints(0.748031496062992)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
            End With
    Application.PrintCommunication = True
    
End Sub
Private Sub Tyousei()
    Keisen
    Daimei
    P_hani
    
End Sub

Public Sub Denpyo()
    Application.ScreenUpdating = False
    Dim wTo As Worksheet
    Dim lnMoto As Long
    Dim lnSaki As Long
    Dim dHiduke As Date
    
    Set wFm = Worksheets("main")
    WsDelete
    wFm.Activate
    Bangou
    Ireru = "B2:" & "B" & wFm.Range("B65536").End(xlUp).Row
    Narabe
       
    For lnMoto = 2 To wFm.Range("B65536").End(xlUp).Row
        If wFm.Range("B" & lnMoto).Value <> wFm.Range("B" & lnMoto - 1).Value Then
            
            If lnMoto > 2 Then
                Tyousei
            End If
            
            lnSaki = 16
            Sheets("main1").Copy After:=Sheets(2)
            Set wTo = Worksheets(3)
            wTo.Name = wFm.Range("B" & lnMoto).Value
        End If
        dHiduke = wFm.Range("C" & lnMoto).Value
        wTo.Range("B" & lnSaki).Value = Left(Year(dHiduke), 2)
        wTo.Range("C" & lnSaki).Value = Month(dHiduke)
        wTo.Range("D" & lnSaki).Value = Day(dHiduke)
        wTo.Range("E" & lnSaki).Value = wFm.Range("D" & lnMoto).Value
        wTo.Range("F" & lnSaki).Value = wFm.Range("E" & lnMoto).Value
        wTo.Range("H" & lnSaki).Value = wFm.Range("F" & lnMoto).Value
        If wFm.Range("G" & lnMoto).Value > 0 Then
            wTo.Range("I" & lnSaki).Value = wFm.Range("G" & lnMoto).Value
        Else
            wTo.Range("J" & lnSaki).Value = wFm.Range("G" & lnMoto).Value
        End If
        If lnMoto > 2 Then
            wTo.Range("K" & lnSaki).Value = wFm.Range("G" & lnMoto).Value + wTo.Range("K" & lnSaki - 1).Value
        Else
            wTo.Range("K" & lnSaki).Value = wFm.Range("G" & lnMoto).Value
        End If
        lnSaki = lnSaki + 1
    Next
    
    Tyousei
    
    Ireru = "A2:" & "A" & wFm.Range("A65536").End(xlUp).Row
    Narabe
    
    wFm.Range("A2:" & "A" & wFm.Range("A65536").End(xlUp).Row).ClearContents
    wFm.Activate
    Application.ScreenUpdating = True
End Sub

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11474]発展編1 フォローメールセミナー 第11回

2019-06-24 13:55:59 小川慶一さんからの投稿です。

とある受講生の方から、添削依頼をいただきました。
以下に添削を示します。

まずは、いただいたコード。

Option Explicit
Dim wFm As Worksheet
Dim Ireru As String
Dim Mx As Long

Sub WsDelete()
    Dim wd As Worksheet
    Application.DisplayAlerts = False
    For Each wd In Worksheets
        If Left(wd.Name, 4) <> "main" Then
            wd.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Sub Bangou()
    wFm.Range("A2").FormulaR1C1 = "1"
    wFm.Range("A2:A317").DataSeries Rowcol:=xlColumns, _
    Type:=xlLinear, Date:=xlDay, _
    Step:=1, Trend:=False
End Sub

Sub Narabe()
    wFm.Sort.SortFields.Clear
    wFm.Sort.SortFields.Add Key:=Range(Ireru), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wFm.Sort
        .SetRange Range("A1:G317")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
Sub Keisen()
    Mx = Range("K65536").End(xlUp).Row
    Range("B16:K" & Mx).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B16:K" & Mx).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B16:K" & Mx)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlHairline
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
    End With
End Sub
Sub Phani()
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveWindow.View = xlNormalView
End Sub

Sub Daimei()
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&F"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&P / &N ページ"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.748031496062992)
        .RightMargin = Application.InchesToPoints(0.748031496062992)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    
End Sub

Sub Denpyo()
    Dim wTo As Worksheet
    Dim Moto As Long
    Dim Saki As Long
    Dim Hiduke As Long
    
    Set wFm = Worksheets("main")
    WsDelete
    wFm.Activate
    Bangou
    Ireru = "B2:B317"
    Narabe
       
    For Moto = 2 To wFm.Range("B65536").End(xlUp).Row
        If wFm.Range("B" & Moto).Value <> wFm.Range("B" & Moto - 1).Value Then
            
            If Moto > 2 Then
                Keisen
                Daimei
                Phani
            End If
            
            Saki = 16
            Sheets("main1").Copy After:=Sheets(2)
            Set wTo = Worksheets(3)
            wTo.Name = wFm.Range("B" & Moto).Value
        End If
        Hiduke = wFm.Range("C" & Moto).Value
        wTo.Range("B" & Saki).Value = Left(Year(Hiduke), 2)
        wTo.Range("C" & Saki).Value = Month(Hiduke)
        wTo.Range("D" & Saki).Value = Day(Hiduke)
        wTo.Range("E" & Saki).Value = wFm.Range("D" & Moto).Value
        wTo.Range("F" & Saki).Value = wFm.Range("E" & Moto).Value
        wTo.Range("H" & Saki).Value = wFm.Range("F" & Moto).Value
        If wFm.Range("G" & Moto).Value > 0 Then
            wTo.Range("I" & Saki).Value = wFm.Range("G" & Moto).Value
        Else
            wTo.Range("J" & Saki).Value = wFm.Range("G" & Moto).Value
        End If
        If Moto > 2 Then
            wTo.Range("K" & Saki).Value = wFm.Range("G" & Moto).Value + wTo.Range("K" & Saki - 1).Value
        Else
            wTo.Range("K" & Saki).Value = wFm.Range("G" & Moto).Value
        End If
        Saki = Saki + 1
    Next
    
    Keisen
    Daimei
    Phani
    
    Ireru = "A2:A317"
    Narabe
    
    wFm.Activate
    wFm.Range("A2:A317").ClearContents
End Sub


そして、以下は、添削内容。

'データ数の増減に耐えられるプログラムにしましょう
'実際にデータ数を増減させて動作確認されると良いかと思います
'「317」という検索キーワードでコード内を検索もしてください
'あと、以下では書いていませんが、SubプロシージャにPublic, Privateキーワードも入れたいですね。
Option Explicit
Dim wFm As Worksheet
Dim Ireru As String
Dim Mx As Long

'↓Excellent v(^^*
Sub WsDelete()
    Dim wd As Worksheet
    Application.DisplayAlerts = False
    For Each wd In Worksheets
        If Left(wd.Name, 4) <> "main" Then
            wd.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

'↓Excellent v(^^*
Sub Bangou()
    wFm.Range("A2").FormulaR1C1 = "1"
    wFm.Range("A2:A317").DataSeries Rowcol:=xlColumns, _
    Type:=xlLinear, Date:=xlDay, _
    Step:=1, Trend:=False
End Sub

Sub Narabe()
    wFm.Sort.SortFields.Clear
    wFm.Sort.SortFields.Add Key:=Range(Ireru), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wFm.Sort
        .SetRange Range("A1:G317") 'データ数可変でもOKになるようになおしましょう
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
Sub Keisen()
    Mx = Range("K65536").End(xlUp).Row
    '[3] 以下、 With Range("B16:K" & Mx) ... End With で [4] までをくくれるのでは?と。
    '以下の要領。
    'With Range("B16:K" & Mx)
    '    .Borders(xlDiagonalDown).LineStyle = xlNone
    '    .Borders(xlDiagonalUp).LineStyle = xlNone
    '    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    '    .Borders(xlEdgeLeft).Weight = xlThin
    '    .Borders(xlEdgeTop).LineStyle = xlContinuous
    '    .Borders(xlEdgeTop).Weight = xlThin
    '    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    '    .Borders(xlEdgeBottom).Weight = xlThin
    '    .Borders(xlEdgeRight).LineStyle = xlContinuous
    '    .Borders(xlEdgeRight).Weight = xlThin
    '    .Borders(xlInsideVertical).LineStyle = xlContinuous
    '    .Borders(xlInsideVertical).Weight = xlHairline
    '    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    '    .Borders(xlInsideHorizontal).Weight = xlHairline
    'End With
    
    Range("B16:K" & Mx).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B16:K" & Mx).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B16:K" & Mx)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlHairline
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
    End With
End Sub
Sub Phani()
    'Sub Print_Area() のように、間にアンダーバーを入れた名前にするのもありです。VBのキーワードには、アンダーバーが入ったものはないので。
    'アンダーバーを間に入れるなら、簡単な英単語の組み合わせでも安全(VBのキーワードとかぶる心配はない)です
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveWindow.View = xlNormalView
End Sub

Sub Daimei()
    '不要と思しきものがかなりありますね。ご自身で設定したものを見出し、それ以外は積極的に削除を!
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&F"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&P / &N ページ"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.748031496062992)
        .RightMargin = Application.InchesToPoints(0.748031496062992)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    
End Sub

Sub Denpyo()
    'Application.ScreenUpdating = False '高速化と画面チラツキ防止のため、画面更新を停止
    '↓Moto, Saki, Hidukeは、ハンガリアン記法にしてもいいかも。たとえば、 sMoto, sSaki, dHidukeという変数名で。
    Dim wTo As Worksheet
    Dim Moto As Long
    Dim Saki As Long
    Dim Hiduke As Long
    
    Set wFm = Worksheets("main")
    WsDelete
    wFm.Activate
    Bangou
    Ireru = "B2:B317" '←データ数可変でも動くようになおしたいですね。
    Narabe
       
    For Moto = 2 To wFm.Range("B65536").End(xlUp).Row 'エクセル2007以降のファイル形式で、かつ、データ数が65566件以上ある場合には注意!
        If wFm.Range("B" & Moto).Value <> wFm.Range("B" & Moto - 1).Value Then
            
            If Moto > 2 Then
                '[1]↓Keisen, Daimei, Phani を実行するプロシージャを何か用意してもよいですね。そうすると、[2]での記述も一行で済みます
                Keisen
                Daimei
                Phani
            End If
            
            Saki = 16
            Sheets("main1").Copy After:=Sheets(2)
            Set wTo = Worksheets(3)
            wTo.Name = wFm.Range("B" & Moto).Value
        End If
        Hiduke = wFm.Range("C" & Moto).Value
        '以下3つは、Format関数を使うこともできます。たとえば直下の行の右辺は、 Format(Fiduke,"yy")
        wTo.Range("B" & Saki).Value = Left(Year(Hiduke), 2)
        wTo.Range("C" & Saki).Value = Month(Hiduke)
        wTo.Range("D" & Saki).Value = Day(Hiduke)
        wTo.Range("E" & Saki).Value = wFm.Range("D" & Moto).Value
        wTo.Range("F" & Saki).Value = wFm.Range("E" & Moto).Value
        wTo.Range("H" & Saki).Value = wFm.Range("F" & Moto).Value
        If wFm.Range("G" & Moto).Value > 0 Then
            wTo.Range("I" & Saki).Value = wFm.Range("G" & Moto).Value
        Else
            wTo.Range("J" & Saki).Value = wFm.Range("G" & Moto).Value
        End If
        If Moto > 2 Then
            wTo.Range("K" & Saki).Value = wFm.Range("G" & Moto).Value + wTo.Range("K" & Saki - 1).Value
        Else
            wTo.Range("K" & Saki).Value = wFm.Range("G" & Moto).Value
        End If
        Saki = Saki + 1
    Next
    
    '[2]
    Keisen
    Daimei
    Phani
    
    Ireru = "A2:A317"
    Narabe
    
    wFm.Activate
    wFm.Range("A2:A317").ClearContents 'データ数可変でもOKになるようになおしましょう
    Application.ScreenUpdating = True '画面更新を再開
End Sub

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

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

2019-06-14 06:10:30 受講生さんからの投稿です。

小川様

お世話になっております。
昨日メールで添削を依頼しましたものを、こちらにも投稿致します。
よろしくお願い致します。

[ 続きを読む ]  返信件数:2件  [ 動画を見る] 

[11272]発展編1 フォローメールセミナー 第30回

2019-03-18 20:51:59 赤澤 勇二さんからの投稿です。

フォローメールメ-ルセミナー第30回ですね。
メールプリントアウトで一冊のファイルが完成しました。
EmEditor大活躍でした。
仕事柄3交代の勤務でメール見るのも朝、夕、真夜中でメールのプリントアウトのみの日も多くありました。
内容は把握出来るので時間をかけて復習します。

追記
復習ついでにカレンダーを改良して日程管理表と日程シミュレーションを作ります。

会社に縛られず でも 楽しく会社に貢献出来るマクロを作成します。 「自分が楽をする為に」

頑張ろう! 日本のモノ作り!!

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11232]発展編1 フォローメールセミナー 第20回

2019-03-08 09:55:42 受講生さんからの投稿です。

色見本ですね 結構会社で使います、何回もマクロ作りました。
機械加工の時に穴あけのサイズとか種類、角度等々、表作成の識別に重宝しています。
保管庫、覚えましたので今度からは取り出すだけにします。

次回も楽しみにしています。

[ 続きを読む ]  返信件数:0件  [ 動画を見る] 

[11231]発展編1 フォローメールセミナー 第20回

2019-03-08 09:53:59 受講生さんからの投稿です。

色見本ですね 結構会社で使います、何回もマクロ作りました。
機械加工の時に穴あけのサイズとか種類、角度等々、表作成の識別に重宝しています。
保管庫、覚えましたので今度からは取り出すだけにします。

次回も楽しみにしています。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11227]発展編1 フォローメールセミナー 第18回

2019-03-06 11:16:10 受講生さんからの投稿です。

小川先生 Selctyon の使い分けでこの様な事が一瞬で出来るマクロを知っただけでも大満足です。

「楽して結果を出したいから!」 

昔N88BASICやDOS_BASICをかなり時間をかけて作りましたが
エクセルのマクロは凄いですね 時間の許す限り覚えたいと思います。

つい最近までCADのマクロを作っていました。

リアルタイムで動くマクロを覚えて、楽しんで爽快に仕事がこなせるのであれば努力は惜しみません。

いちばん楽な書き方 ご指導宜しくお願い致します。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11218]発展編1 フォローメールセミナー 第14回

2019-03-04 07:15:05 受講生さんからの投稿です。


インターネットで検索したのですが表記の方法が変わってるみたいで

Sheet1上のセルA1の文字列
第001回 「巨大台風から日本を守れ 富士山頂・男たちは命をかけた」(富士山レーダ
ー・三菱電機 3月28日)

の部分が 
コピペした内容

001 3月28日 巨大台風から日本を守れ
富士山頂・男たちは命をかけた 富士山レーダー 三菱電機 –

このような状況になりました。
「  」と ( )と 他 抜けてしまいました。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

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

2019-03-03 23:05:43 受講生さんからの投稿です。

伝票印刷(1ページ全部入る)印刷出来る時と出来ない時があり困っています。
長い伝票は出来ます。
.FitToPagesWide = 390 ←プリンターが毎回10-400の入力を求めて来ます。
エクセル操作では問題無く(1ページ全部入る)印刷が出来ます。

[ 続きを読む ]  返信件数:2件  [ 動画を見る] 

[11191]発展編1 フォローメールセミナー 第6回

2019-02-22 09:16:31 受講生さんからの投稿です。

連続データ(シート追加後)はどうなっているのか今まで知りませんでしたが今回の講座で明確に分かりました。
if文でシート名が違っていたら、新しいシートを作り(st 名)シートを開いたまま、16行目からシート名が変わるまで(lnTo = lnTo + 1)連続データを書き加える、st名が変わったら(lnTo = 16)16行目から連続データを書き加えるですね
疑問が二つ有りまして一つ減りました。もう一つの疑問が連続シートの個々の(.xls)ファイル作成です。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11188]発展編1 フォローメールセミナー 第4回

2019-02-20 10:04:45 受講生さんからの投稿です。

ワークシートの変数便利ですね 
「目標 フォローメールセミナーには2回に1回は感想を送る事にする」

Sub Sample()
Dim shTo As Worksheet
Set shTo = ActiveSheet
shTo.Name = st
End Sub


Right(Year(dt), 2) Year関数も覚えます。
紙に書いて持ち歩きます。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11181]発展編1 フォローメールセミナー 第2回

2019-02-18 09:37:22 受講生さんからの投稿です。

こんにちは今回メールセミナーでハマってしまいました。
メールとエクセルデータのみでマクロを作りましたが、shFmのところ無意識に読み飛ばしていました。
InFmMax = Range(“b65536”).End(xlUp).Row

lnFmMx = shFm.Range(“B65536”).End(xlUp).Row


st = Range(“B” & Infm).Value

st = shFm.Range(“B” & lnFm).Value
オンライン講座にアクセスしていれば読み飛ばさなかったと思います。

予習ですが
Sub deletsSheets()
Dim ws As Worksheet
For Each ws In Worksheets
Debug.Print ws.Name

If Left(ws.Name, 4) <> “main” Then
ws.Delete
End If
Next
End Sub
ワークシート削除プログラム少しやってみました。動画が沢山ありどの動画か思い出せない事が有ります50代男性です。
分かり易い解説ありがとうございます。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11142]発展編1 フォローメールセミナー 第11回

2019-02-13 05:06:07 A.Sさんからの投稿です。

小川先生

いつもお世話になっております。
第9回に引き続き、第11回の宿題を提出させていただきます。
お忙しいところ大変恐れ入りますが、添削の程、どうぞよろしくお願い致します。

Sub CreateDenpyo()
    DeleteSheets
    Template_Setup
    Numbering
    Narabekae_Torihikisaki
    Denpyosheet_Set
    Narabekae_No
    NumberingDelete
End Sub

'「main1」シートのページ設定をするマクロ
Private Sub Template_Setup()
    With Sheets("main1").PageSetup
        .PrintArea = "" '印刷範囲の解除
        .CenterHeader = "&A" 'ヘッダーに「シート名」を挿入
        .CenterFooter = "&P" 'フッターに「ページ番号」を挿入
    End With
    Range("A1").Select
End Sub

'「main」シートのA列に番号を振るマクロ
Private Sub Numbering()
    Dim ln As Long
    Dim lnMx As Long
    Dim ws As Worksheet
    Set ws = Worksheets("main")
    ws.Range("A1").Value = "No."
    lnMx = ws.Range("B" & Rows.Count).End(xlUp).Row
    For ln = 2 To lnMx
        ws.Range("A" & ln).Value = ln
    Next
End Sub

'「main」シートのA列のデータを全て削除するマクロ
Private Sub NumberingDelete()
    Dim lnMx As Long
    Dim ws As Worksheet
    Set ws = Worksheets("main")
    lnMx = ws.Range("A" & Rows.Count).End(xlUp).Row
    ws.Range("A1:A" & lnMx).ClearContents
End Sub

'「main」シートのB列を昇順に並び替えるマクロ
Private Sub Narabekae_Torihikisaki()
    With Worksheets("main").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("B2:B317"), _
    SortOn:=xlSortOnValues, _
    Order:=xlAscending, _
    DataOption:=xlSortNormal
    .SetRange Range("A1:G317")
    .Header = xlYes
    .Apply
    End With
End Sub

'「main」シートのA列を昇順に並び替えるマクロ
Private Sub Narabekae_No()
    With Worksheets("main").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("A2:A317"), _
    SortOn:=xlSortOnValues, _
    Order:=xlAscending, _
    DataOption:=xlSortNormal
    .SetRange Range("A1:G317")
    .Header = xlYes
    .Apply
    End With
End Sub

'取引先毎の伝票シートを作成するマクロ
Private Sub Denpyosheet_Set()
    DeleteSheets
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim lnTo As Long
    Dim st As String
    Dim wsFm As Worksheet
    Dim wsTo As Worksheet
    Dim dt As Date
    Set wsFm = Worksheets("main")
    lnFmMx = wsFm.Range("B" & Rows.Count).End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If st <> wsFm.Range("B" & lnFm).Value Then
            If lnFm > 2 Then
                Keisen
            End If
            st = wsFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Set wsTo = ActiveSheet
            wsTo.Name = st
            lnTo = 16
        End If
        wsTo.Range("E" & lnTo).Value = wsFm.Range("D" & lnFm).Value
        wsTo.Range("F" & lnTo).Value = wsFm.Range("E" & lnFm).Value
        wsTo.Range("H" & lnTo).Value = wsFm.Range("F" & lnFm).Value
        If wsFm.Range("G" & lnFm).Value > 0 Then
            wsTo.Range("I" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("J" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        End If
        If lnTo = 16 Then
            wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value + wsTo.Range("K" & lnTo).Offset(-1).Value
        End If
        dt = wsFm.Range("C" & lnFm).Value
        wsTo.Range("B" & lnTo).Value = Format(dt, "yy")
        wsTo.Range("C" & lnTo).Value = Format(dt, "m")
        wsTo.Range("D" & lnTo).Value = Format(dt, "d")
        lnTo = lnTo + 1
    Next
    Keisen
End Sub

'取引先名称シートを削除するマクロ
Public Sub DeleteSheets()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Left(ws.Name, 4) <> "main" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

'取引先名称シートに罫線を作成するマクロ
Private Sub Keisen()
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    With Range("B16:K" & lnMx + 1)
    .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 = xlHairline
        End With
    End With
End Sub

[ 続きを読む ]  返信件数:5件  [ 動画を見る] 

[11122]発展編1 フォローメールセミナー 第26回

2019-02-11 05:20:39 Takao Kanekoさんからの投稿です。

小川先生、
Module18の下記の課題について質問があります。
[3]で見つけてきた曜日の背景色を調べてくる
[4]で調べた色で、[1]で取得したセル全体を塗りつぶす
土曜日に青色、日曜日に赤色となるはずが、
日曜日に青色、月曜日に赤色と一つズレた実行結果になります。

自分が書いていたマクロに問題があるのかと思いましたが、新しくダウンロードした回答も同じになりました。
実行した年度は、2009年と2019年です。
さらに、「なんでだろう?」と自分で簡単なテストしました。
2019年1月1日(火)なので、Weekday関数の引数は3となるのですが、
なぜかWeekdayname関数だと、水曜日となります。
今朝から、この解けきれない問題のループにハマってしまってます。
どうかお教え頂けますでしょうか?
よろしくお願いします。

Takao

[ 続きを読む ]  返信件数:5件  [ 動画を見る] 

[11089]発展編1 フォローメールセミナー 第25回

2019-02-09 17:30:14 Takao Kanekoさんからの投稿です。

小川先生、

1.With EndWithの中の構文は、オブジェクトを指定すれば、こちらが認識されて動くのは新しい発見でした。今までWith構文は、その同じオブジェクトを対象とするものしか入れられないと思ってました。

その動作が見られたのは、Module16 With構文中のさらに、For nextの入れ子の ”rgSummary.Offset(c, cYoko).Formula =”が始まる部分です。

2.
rgSummaryというように、
シートのRangeに変数名を付ける、この変数名がすごくわかりやすいと思いました。
参考にしたいと思います。

3.
>ちなみに、ここまでスラスラとできる人は、すでに達人です。
そうなれるように、引き続きがんばります٩( ‘ω’ )و !

Takao

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

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

2019-02-04 20:32:10 A.Sさんからの投稿です。

小川先生

いつも分かり易い講座をありがとうございます。
発展編1 フォローメールセミナー 第9回で宿題をいただいた伝票作成マクロを作成しましたので送らせていただきます。
自分なりに最初から作成していき、途中で詰まりながらも何とか最後まで辿り着き、動くところまで確認できました。
お忙しいところ大変恐れ入りますが、添削の程、どうぞよろしくお願い致します。

[ 続きを読む ]  返信件数:5件  [ 動画を見る] 

[11057]発展編1 フォローメールセミナー 第22回

2019-02-01 03:35:39 Takao Kanekoさんからの投稿です。

小川先生、

早速のご返答ありがとうございます。
Tempの略称だったのですね。
小川先生の変数名は、略称なのにかかわらず、パッと見てすぐ意味が分かるものななので、こういうところも真似したいと思い質問させていただきました。

学習方法の方向性が間違ってないことが判り、安心しました。

そうでした。自力で書けた次は、自分の言葉で人に説明しながら、学ぶスタイルでさらに上を目指して理解を深めたいと思います。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[11054]発展編1 フォローメールセミナー 第22回

2019-01-31 20:38:20 Takao Kanekoさんからの投稿です。

小川先生、

少し細かいことで申し訳ないのですが、
Dim dtTp As Dateの”Tp”は何の意味を指しますか?

この第22回のセミナーは、今まで触れることがなかった日付マクロ作成などを学習出来てよかったです。

始めは慣れなかったので、トライ・アンド・エラーを何回も繰り替えして演習問題を解きました。そうすると、ステップインF8でロジックの理解よりも、記憶を頼りにしマクロを書き上げているような気がしました。マクロはちゃんと動きますし、今まで分からないところは、基礎編の演習問題もこうして解いて、後でピーンと来たりします。この学習方法で、何か改善するところがあれば、お教え下さい。大丈夫でしょうか。

どうぞよろしくお願いします。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[10884]発展編1 フォローメールセミナー 第10回

2019-01-04 22:09:01 受講生さんからの投稿です。

ありがとうございます。誰かのためにと思って、再度復習をさせていただいております。
こういった内容ご掲示いただきまして、ありがとうございます。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[10660]発展編1 フォローメールセミナー 第21回

2018-10-20 13:06:42 受講生さんからの投稿です。

お世話になっております。
内容的に送信先がこちらではない気もしますが、ご対応お願い致します。
第20回のメールセミナーが届いていません。
再送をお願いいたします。

[ 続きを読む ]  返信件数:0件  [ 動画を見る] 

[10631]発展編1 フォローメールセミナー 第12回

2018-10-06 06:56:34 わかやまさんからの投稿です。

小川様

インデントの重要度を再認識いたしました。
それと、修正したコードの中身が気になりました。
これはどれぐらい先に扱えるようになるでしょうか?

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[10630]発展編1 フォローメールセミナー 第11回

2018-10-06 06:40:04 わかやまさんからの投稿です。

小川様 

添削よろしくお願いいたします。

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 'ワークシートを指定しました
    heda 'ヘッダーとフッターの設定
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


Sub heda()
    With Worksheets("main1").PageSetup
        .CenterHeader = "伝票"
        .CenterFooter = Date
    End With
End Sub

[ 続きを読む ]  返信件数:3件  [ 動画を見る] 

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

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

[ 続きを読む ]  返信件数:3件  [ 動画を見る] 

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

2018-10-03 05:06:50 受講生さんからの投稿です。

小川様

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

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

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

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

2018-10-01 06:22:21 わかやまさんからの投稿です。

小川様

いつもありがとうございます。添削をお願いいたします。

Sub ikkini()
    sort1
    hontai
End Sub


Sub sort1()
Dim kazu As Long
Dim saigo As Long
Columns(“A:G”).Select
ActiveWorkbook.Worksheets(“main”).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(“main”).Sort.SortFields.Add Key:=Range(“B2:B317”), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(“main”).Sort
.SetRange Range(“A1:G317”)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

saigo = Worksheets(“main”).Range(“B65536”).End(xlUp).Row
Worksheets(“main”).Range(“A1”).Value = “No.”
For kazu = 2 To saigo
Worksheets(“main”).Range(“A” & kazu).Value = kazu – 1
Next
End Sub[/code]


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


Sub hontai()
    syokyo
    Dim gyo As Long
    Dim saigo1 As Long
    Dim wsmain As Worksheet
    Dim wsnow As Worksheet
    Dim gyosya As String
    Dim dt As Date
    Dim saki As Long
    Set wsmain = Worksheets("main")
    saigo1 = wsmain.Range("B65536").End(xlUp).Row
    For gyo = 2 To saigo1
        If gyosya <> wsmain.Range("B" & gyo).Value Then
            If gyo > 2 Then
                keisen
            End If
            Sheets("main1").Copy After:=Sheets(2)
            Sheets("main1 (2)").Name = wsmain.Range("B" & gyo).Value
            Set wsnow = ActiveSheet
            gyosya = wsnow.Name
            saki = 16
        End If
            wsnow.Range("F2").Value = wsnow.Name
            wsnow.Range("H" & saki).Value = wsmain.Range("F" & gyo).Value
            wsnow.Range("F" & saki).Value = wsmain.Range("E" & gyo).Value
            wsnow.Range("E" & saki).Value = wsmain.Range("D" & gyo).Value
            dt = wsmain.Range("C" & gyo).Value
            wsnow.Range("B" & saki).Value = Right(Year(dt), 2)
            wsnow.Range("C" & saki).Value = Month(dt)
            wsnow.Range("D" & saki).Value = Day(dt)
            If wsmain.Range("G" & gyo) > 0 Then
                wsnow.Range("I" & saki).Value = wsmain.Range("G" & gyo).Value
            ElseIf wsmain.Range("G" & gyo) < 0 Then
                wsnow.Range("J" & saki).Value = wsmain.Range("G" & gyo).Value
            End If
            If saki = 16 Then
                wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value
            Else
                wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value + wsnow.Range("K" & saki - 1)
            End If
            saki = saki + 1
    Next
    keisen
End Sub


Sub keisen()
    Dim saigo2 As Long
    Dim wsnow1 As Worksheet
    Set wsnow1 = ActiveSheet
    saigo2 = wsnow1.Range("B65536").End(xlUp).Row
    Range("B16:K" & saigo2).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    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
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End Sub

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

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

2018-08-30 08:24:57 受講生さんからの投稿です。

いつもお世話になっております。
なんとか作成出来ましたが、まだまだ時間がかかっております。でも、自分でも出来ることがわかったので、大変満足しております。作成したファイルを送らせていただきます。お手数ですが、よろしくお願いいたします。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[10488]発展編1 フォローメールセミナー 第24回

2018-08-22 23:20:54 マメコトさんからの投稿です。

「Loopをwithで囲む」というヒントの意味を汲み切れず、問題[4]は未解答のままで今回の解答を拝見しました。
・・・これは秀麗ですね。
range(“A” & c)、range(“B” & c)、という朴訥としたコードより、明らかに洗練されている感じがします。
offsetを「for next構文の横方向バージョン」ぐらいに軽く考えていましたが、withと組み合わせると、こんなにスッキリしたコードになるのですね。
それと、この美しいコードを「読みこなせている」という事実に、率直に自分自身が驚いています。先生のご指導のおかげです。ありがとうございます。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

[10472]発展編1 フォローメールセミナー 第11回

2018-08-21 21:32:27 マメコトさんからの投稿です。

お世話になっております。

Sub Denpyou()
    Call Sort_First
    Call Delete_Sheets
    Call Create_Denpyou
    Call Sort_End
End Sub

という伝票作成マクロの、Create_Denpyouの中にCreate_Keisenを作り、そのCreate_Keisenの最後に印刷に関するコードを書きました。
・・・とは言え、マクロの記録のどこを削れば良いのかわかりませんでした。
Private Sub Create_Keisen()

    Dim nGyou As Long
    
    nGyou = Range("E" & Rows.Count).End(xlUp).Row
    
    Range("B16:K" & nGyou).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ":"
        .PrintTitleColumns = ""
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .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)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 10
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = True
End Sub

やはりひとつひとつ意味を調べるべきなのでしょうか。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 

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

2018-08-21 16:56:10 マメコトさんからの投稿です。

先生のように30分では書けませんでしたが、1時間はかからずに書けました。(ボタンは作りませんでしたけど。)
「とりあえず動く」ものなので、マクロが記録したコードをそのまま使ったりしています。
いかがでしょうか。

[ 続きを読む ]  返信件数:1件  [ 動画を見る] 


各講座ごとのメッセージを見る場合はこちら

 

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

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

トップへ