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

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

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

2021-04-15 22:53:47 受講生さんからの投稿です。

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

先日、職場で出社/在宅勤務の予定表(縦が社員一覧、横が日にちの表)を作る機会があり、カレンダー作成マクロを活用することができました。

「とりあえず4月分を作って!」との依頼でしたが、5月以降も必要になるので、来年3月分まで作ってしまいました。

手作業だと1ヶ月分を作るのも大変ですが、マクロなら1年分、土日祝日に色付けをしてもあっという間ですね。

こういう便利なものが作れるようになり、人の役にも立てて本当に良かったです。ありがとうございます。

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

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

2021-02-20 11:07:22 らりおさんからの投稿です。

お世話になっております。
 このメールセミナーの中で、特にカレンダーマクロが初めはかなり難しく感じました。メールを見てサンプルコードを少し指示どうりに編集するだけで精一杯だったのを今でも覚えています。
 しかし何とかものにしたい思いで1からの作成を7回くらい繰り返しました。気づけば、先ほど添削してもらうために投稿したカレンダーマクロを、何も見ずに1時間以内で書きあげられるようになりました。
 どんなに難しそうに見えても諦めずに反復することで身につけることができるのだと、自信になりました。このような講座を用意して頂きありがとうございます。(人”▽`)
 本日から発展編2に進みます。これからもどうぞよろしくお願いします。

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

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

2021-02-20 10:50:21 受講生さんからの投稿です。

お世話になっております。
空でカレンダーマクロを1から作りましたので添削して頂けると嬉しいです。
コメント部分に自身なりの考えでアレンジした部分を示しています。
よろしくお願いします。(`・ω・´)

Option Explicit
Dim c, saKi, saiGo, yoKo, Gyo As Long '変数をカテゴリー別にまとめた
Dim Hiduke, hiNiti As Date
Dim Sum, Ctrl, ws As Worksheet
Dim SumrA, CtrlA1, CtrlF2 As Range
Dim Syuku As Boolean
'これくらいのものであれば、シート作成とカレンダ―内の作業の
'プロシージャを分けなくてもそこまでややこしくないと考え、一緒にした。
Sub Carenda_soukatu()
    Sheet_sakujo
    Hiduke = #1/1/2021#
    Set Sum = Worksheets("Summary")
    Set Ctrl = Worksheets("Control")
    Set CtrlA1 = Ctrl.Range("A1")
    For c = 1 To 12
        Sum.Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = c & "月"
    Next
    For c = 1 To 12
        Worksheets(c & "月").Activate
        saiGo = Sum.Range("A" & Sum.Rows.Count).End(xlUp).Row + 1
        Carenda_main
        Hiduke = DateAdd("m", 1, Hiduke)
    Next
    Ctrl.Activate
End Sub
Sub Carenda_main()
    hiNiti = Hiduke
    saKi = 0
    With Range("A2")
        Do While Month(hiNiti) = Month(Hiduke)
            .Offset(saKi).Value = hiNiti
            .Offset(saKi, 1).Value = WeekdayName(Weekday(hiNiti))
            .Offset(saKi, 2).Value = #9:00:00 AM#
            .Offset(saKi, 3).Value = #5:00:00 PM#
            .Offset(saKi, 4).Formula = "=" & .Offset(saKi, 3).Address & "-" & .Offset(saKi, 2).Address
            Set SumrA = Sum.Range("A" & saiGo)
            For yoKo = 0 To 4
                SumrA.Offset(saKi, yoKo).Formula = "=" & .Worksheet.Name & "!" & .Offset(saKi, yoKo).Address
            Next
            
            Syuku_hantei
            Set CtrlF2 = Ctrl.Range("F2") '4回も出てきて煩わしいので1つの変数として置いた
            If Syuku = True Then
                With Range(.Offset(saKi), .Offset(saKi, 4))
                    .Interior.Color = CtrlF2.Interior.Color
                    .Font.Color = CtrlF2.Font.Color
                End With
                With Range(SumrA.Offset(saKi), SumrA.Offset(saKi, 4))
                    .Interior.Color = CtrlF2.Interior.Color
                    .Font.Color = CtrlF2.Font.Color
                End With
            Else
                With Range(.Offset(saKi), .Offset(saKi, 4))
                    .Interior.Color = CtrlA1.Offset(Weekday(hiNiti)).Interior.Color
                    .Font.Color = CtrlA1.Offset(Weekday(hiNiti)).Font.Color
                End With
                With Range(SumrA.Offset(saKi), SumrA.Offset(saKi, 4))
                    .Interior.Color = CtrlA1.Offset(Weekday(hiNiti)).Interior.Color
                    .Font.Color = CtrlA1.Offset(Weekday(hiNiti)).Font.Color
                End With
            End If
            
            hiNiti = DateAdd("d", 1, hiNiti)
            saKi = saKi + 1
        Loop
    End With
End Sub
Sub Syuku_hantei()
    Syuku = False
    For Gyo = 2 To 18
'あくまで今年のカレンダーを作ったため↓。
        If Month(hiNiti) = Month(Ctrl.Range("C" & Gyo).Value) And _
           Day(hiNiti) = Day(Ctrl.Range("C" & Gyo).Value) Then
            Syuku = True
            Exit For
        End If
    Next
End Sub
Sub Sheet_sakujo()
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If ws.Name <> "Control" And ws.Name <> "Summary" Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
    Sum_clear
End Sub
Sub Sum_clear()
    Set Sum = Worksheets("Summary")
    saiGo = Sum.Range("A" & Sum.Rows.Count).End(xlUp).Row
    If saiGo > 1 Then
        With Sum.Range("A2:E" & saiGo)
            .ClearContents
            .Interior.Color = xlNone
            .Font.Color = vbBlack
        End With
    End If
End Sub

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

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

2021-02-11 08:32:11 加藤さんからの投稿です。

課題作成いたしました。
添削よろしくお願いいたします。

 Sub denpyosakusei()
    Worksheetsdelete
    Dim shFm As Worksheet
    Set shFm = Worksheets("main")
    Dim cFm
    Dim shName
    Dim shTo As Worksheet
    Dim cTo
    For cFm = 2 To shFm.Range("B65536").End(xlUp).Row
        shFm.Range("A" & cFm).Value = cFm - 1
    Next
    shFm.Range("A1").Value = "通番"
    With shFm
        .Range("A1").Sort key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
    End With
    For cFm = 2 To shFm.Range("B65536").End(xlUp).Row
        If shFm.Range("B" & cFm).Value <> shFm.Range("B" & cFm - 1).Value Then
            cTo = 16
            shName = shFm.Range("B" & cFm).Value
            Worksheets("main1").Copy After:=ActiveSheet
            ActiveSheet.Name = shName
        End If
        Set shTo = Worksheets(shName)
        shTo.Range("E" & cTo).Value = shFm.Range("D" & cFm).Value
        shTo.Range("F" & cTo).Value = shFm.Range("E" & cFm).Value
        shTo.Range("H" & cTo).Value = shFm.Range("F" & cFm).Value
        shTo.Range("B" & cTo).Value = Left(shFm.Range("C" & cFm).Value, 4)
        shTo.Range("C" & cTo).Value = Mid(shFm.Range("C" & cFm).Value, InStr(shFm.Range("C" & cFm).Value, "/") + 1, 2)
        shTo.Range("D" & cTo).Value = Right(shFm.Range("C" & cFm).Value, 2)
        If shFm.Range("G" & cFm).Value < 0 Then
            shTo.Range("I" & cTo).Value = 0 - shFm.Range("G" & cFm).Value
        Else
            shTo.Range("J" & cTo).Value = shFm.Range("G" & cFm).Value
        End If
        cTo = cTo + 1
        shTo.Range("B16" & ":K" & shTo.Range("H65536").End(xlUp).Row).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
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    Next
    shFm.AutoFilter.Sort.SortFields.Clear
    shFm.AutoFilter.Sort.SortFields.Add2 _
    Key:=Range("A1"), _
    SortOn:=xlSortOnValues, _
    Order:=xlAscending, _
    DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shFm.Activate
    shFm.Range("A2" & ":A" & shFm.Range("B65536").End(xlUp).Row).ClearContents
End Sub

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

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

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

2021-02-02 23:13:29 受講生さんからの投稿です。

お世話になります。課題を提出いたします。
第9回でフィードバックをいただいたき、その後練習を重ねた結果、30分で書けるようになりました。
2時間半掛かっていた頃と比べると、頭の負荷が減り、余裕が出てきました。
実務の方でも良い出来事があり、自分の書いたマクロが社内ツール(補助ツールですが)として展開されることになりました。他人に使ってもらうのは初めてで、嬉しさも不安もありますが、「人に喜んでもらえるものを作りたい」という気持ちがより強くなりました。更なるスキルアップを目指します。

Option Explicit
Dim wsFm As Worksheet
Dim lnFmMx As Long
Dim stKey As String
Dim wsTo As Worksheet

Public Sub Sakusei_Button() '「伝票作成」ボタンに割り当て
    Application.ScreenUpdating = False

    Denpyo_Sakujo

    Set wsFm = Worksheets("main")
    lnFmMx = wsFm.Range("B" & Rows.Count).End(xlUp).Row

    main_Saiban

    stKey = "B"
    main_Narabekae

    Denpyo_Sakusei
    
    stKey = "A"
    main_Narabekae
    
    main_Saiban_Sakujo
    
    Application.ScreenUpdating = True

    MsgBox ("作成しました。")
End Sub

Public Sub Sakujo_Button() '「伝票削除」ボタンに割り当て
    Denpyo_Sakujo
    MsgBox ("削除しました。")
End Sub

'マクロの記録をしながらテンプレートに以下の設定を実施
'Private Sub main1_Print_Settei()
'    Worksheets("main1").Columns("H:H").ColumnWidth = 14.5
'    Application.PrintCommunication = False
'    With Worksheets("main1").PageSetup
'        .PrintArea = ""
'        .RightHeader = "&D, &T" & Chr(10) & "&A"
'        .CenterFooter = "&P / &N ページ"
'        .Orientation = xlPortrait
'        .FitToPagesWide = 1
'        .FitToPagesTall = False
'    End With
'    Application.PrintCommunication = True
'End Sub

Private Sub main_Saiban()
    wsFm.Range("A1").Value = "No."
    wsFm.Range("A2").Value = "1"
    wsFm.Range("A3").Value = "2"
    wsFm.Range("A2:A3").AutoFill _
        Destination:=wsFm.Range("A2:A" & lnFmMx)
End Sub

Private Sub main_Saiban_Sakujo()
    wsFm.Range("A1:A" & lnFmMx).ClearContents
End Sub

Private Sub main_Narabekae()
    With wsFm.Sort
        With .SortFields
            .Clear
            .Add _
                Key:=wsFm.Range(stKey & "2:" & stKey & lnFmMx), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
        End With
        .SetRange wsFm.Range("A1:G" & lnFmMx)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub Denpyo_Sakusei()
    Dim lnFm As Long
    Dim st As String
    Dim lnTo As Long
    Dim dt As Date
    Dim cur As Currency
    
    For lnFm = 2 To lnFmMx
        If st <> wsFm.Range("B" & lnFm).Value Then
            If lnFm > 2 Then
                Denpyo_Keisen
            End If
            st = wsFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set wsTo = Worksheets("main1 (2)")
            wsTo.Name = st
            lnTo = 16
        End If
        
        dt = wsFm.Range("C" & lnFm).Value
        cur = wsFm.Range("G" & lnFm).Value
        
        With wsTo.Range("B" & lnTo)
            .Value = Format(dt, "yy")
            .Offset(, 1).Value = Format(dt, "mm")
            .Offset(, 2).Value = Format(dt, "dd")
            .Offset(, 3).Value = wsFm.Range("D" & lnFm).Value
            .Offset(, 4).Value = wsFm.Range("E" & lnFm).Value
            .Offset(, 6).Value = wsFm.Range("F" & lnFm).Value
            Select Case cur
                Case Is > 0
                    .Offset(, 7).Value = cur
                Case Else
                    .Offset(, 8).Value = cur
            End Select
            Select Case lnTo
                Case Is = 16
                    .Offset(, 9).Value = cur
                Case Else
                    .Offset(, 9).Value = cur + .Offset(-1, 9).Value
            End Select
        End With
        lnTo = lnTo + 1
    Next
    Denpyo_Keisen
    wsFm.Activate
End Sub

Private Sub Denpyo_Sakujo()
    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 Denpyo_Keisen()
    Dim lnMx As Long
    lnMx = wsTo.Range("B" & Rows.Count).End(xlUp).Row
    With wsTo.Range("B16:K" & lnMx + 1)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
    End With
End Sub

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

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

2021-01-31 22:20:03 受講生さんからの投稿です。

提出いたします。

Option Explicit
Dim S_main As Worksheet
Dim S_hina As Worksheet
Dim saigo As Long
Sub zentai()
Set S_main = Worksheets(“main”)
Set S_hina = Worksheets(“main1”)
saigo = S_main.Range(“B65536”).End(xlUp).Row
anum
bnara
fuyokeshi
tenki ‘中にkeisen
anara
End Sub
Sub anum()
Dim n As Long
For n = 2 To saigo
S_main.Range(“A” & n).Value = n – 1
Next
End Sub

Sub bnara()
Range(“A1:G317”).Sort _
key1:=Range(“B1”), _
Order1:=xlAscending, _
Header:=xlYes
End Sub

Sub anara()
Range(“A1:G317”).Sort _
key1:=Range(“A1”), _
Order1:=xlAscending, _
Header:=xlYes
End Sub
Sub fuyokeshi()
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In Worksheets
If Left(ws.Name, 4) <> “main” Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
Sub tenki()
Dim mgyo As Long
Dim mtori As String
Dim S_copy As Worksheet
Dim copygyo
Dim dt As Date
For mgyo = 2 To saigo
mtori = S_main.Range(“B” & mgyo).Value
If mtori <> S_main.Range(“B” & mgyo – 1).Value Then
If mgyo > 2 Then
keisen
End If
copygyo = 16
S_hina.Copy after:=Sheets(2)
Set S_copy = ActiveSheet
S_copy.Name = mtori
End If
S_copy.Range(“E” & copygyo).Value = S_main.Range(“D” & mgyo).Value
S_copy.Range(“F” & copygyo).Value = S_main.Range(“E” & mgyo).Value
S_copy.Range(“H” & copygyo).Value = S_main.Range(“F” & mgyo).Value
dt = S_main.Range(“C” & mgyo).Value
S_copy.Range(“B” & copygyo).Value = Right(Year(dt), 2)
S_copy.Range(“C” & copygyo).Value = Month(dt)
S_copy.Range(“D” & copygyo).Value = Day(dt)
If S_main.Range(“G” & mgyo).Value > 0 Then
S_copy.Range(“J” & copygyo).Value = S_main.Range(“G” & mgyo).Value
Else
S_copy.Range(“I” & copygyo).Value = S_main.Range(“G” & mgyo).Value
End If
If copygyo = 16 Then
S_copy.Range(“K” & copygyo).Value = S_main.Range(“G” & mgyo).Value
Else
S_copy.Range(“K” & copygyo).Value = S_main.Range(“G” & mgyo).Value + S_copy.Range(“K” & copygyo – 1).Value
End If
copygyo = copygyo + 1
Next
keisen
S_main.Select
End Sub
Sub keisen()
Dim copysaigo As Long
copysaigo = Range(“B65536”).End(xlUp).Row
With Range(“B16:K” & copysaigo)
.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 = xlThin
End With
End With
End Sub

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

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

2021-01-16 11:30:58 受講生さんからの投稿です。

小川先生

課題作成致しました。ほとんど何も見ずにできたことに感動しました。
荒削りかとは思いますが、添削願います。

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

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

2021-01-11 18:36:47 受講生さんからの投稿です。

お世話になります。課題を提出いたします。
何も見ずにやって2時間半掛かりました。
フィードバックを宜しくお願いいたします。

Option Explicit
Public Sub Denpyo_Sakusei() '「伝票作成」ボタンに割り当て
    No_Saiban
    Sort_Torihikisaki
    Denpyo_Copy
    Sort_No
    MsgBox "完了しました。"
End Sub
Public Sub Denpyo_Sakujo() '「伝票削除」ボタンに割り当て
    Sheet_Sakujo
    MsgBox "削除しました。"
End Sub
Private Sub Denpyo_Copy()
    Sheet_Sakujo
    Dim wsFm As Worksheet
    Dim wsTo As Worksheet
    Dim st As String
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim lnTo As Long
    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(2)
            Set wsTo = Worksheets("main1 (2)")
            wsTo.Name = st
            lnTo = 16
        End If
        
        dt = wsFm.Range("C" & lnFm).Value
        wsTo.Range("B" & lnTo).Value = Format(dt, "yy")
        wsTo.Range("C" & lnTo).Value = Format(dt, "mm")
        wsTo.Range("D" & lnTo).Value = Format(dt, "dd")
        
        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 = wsTo.Range("K" & lnTo - 1).Value + wsFm.Range("G" & lnFm).Value
        End If
        lnTo = lnTo + 1
    Next
    keisen
    wsFm.Activate
End Sub

Public Sub Sheet_Sakujo()
    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 No_Saiban()
    Dim ln As Long
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    Range("A1").Value = "No."
    For ln = 2 To lnMx
        Range("A" & ln).Value = ln
    Next
End Sub

Private Sub Sort_Torihikisaki()
    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
End Sub

Private Sub Sort_No()
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Add _
        Key:=Range("A2:A317"), _
        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
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select
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件  [ 動画を見る] 

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

2021-01-03 19:51:29 らりおさんからの投稿です。

[宿題] お世話になっております。前回時(第9回)とは別に、もう一度イチから作成しました。追加課題の題意に正しく沿ったものができているかどうかも含めて添削お願い致します。

Option Explicit
Dim wM As Worksheet
Dim wM1 As Worksheet
Dim wAc As Worksheet
Dim w As Worksheet

Dim moTo As Long
Dim saKi As Long
Dim saiGo As Long
Dim Kingaku As Long

Dim HiDuke As Date

Sub denpyosakusei()
    Set wM = Workbooks("s09_homework.xls").Worksheets("main")
    Set wM1 = Workbooks("s09_homework.xls").Worksheets("main1")
    saiGo = wM.Range("B" & wM.Rows.Count).End(xlUp).Row
    
    syokyo
    main1_kairyo
    No
    wM.Range("A1:G" & saiGo).Sort key1:=wM.Range("B1"), Order1:=xlAscending, Header:=xlYes 'B列で並べ替え
    
    For moTo = 2 To saiGo
        HiDuke = wM.Range("C" & moTo).Value
        If wM.Range("B" & moTo).Value <> wM.Range("B" & moTo - 1).Value Then
            saKi = 0
            Kingaku = 0
            wM1.Copy after:=wM
            Set wAc = ActiveSheet
            wAc.Name = wM.Range("B" & moTo).Value
        End If
        With wAc.Range("B16")
            .Offset(saKi).Value = Mid(Year(HiDuke), 3)
            .Offset(saKi, 1).Value = Month(HiDuke)
            .Offset(saKi, 2).Value = Day(HiDuke)
            .Offset(saKi, 3).Value = wM.Range("D" & moTo).Value
            .Offset(saKi, 4).Value = wM.Range("E" & moTo).Value
            .Offset(saKi, 6).Value = wM.Range("F" & moTo).Value
            Select Case wM.Range("G" & moTo).Value
                Case Is > 0
                    .Offset(saKi, 7).Value = wM.Range("G" & moTo).Value
                Case Else
                    .Offset(saKi, 8).Value = wM.Range("G" & moTo).Value
            End Select
            Kingaku = Kingaku + wM.Range("G" & moTo).Value
            .Offset(saKi, 9).Value = Kingaku
        End With
        saKi = saKi + 1
        If wM.Range("B" & moTo).Value <> wM.Range("B" & moTo + 1).Value Then
            With wAc.Range("B16:K" & saKi + 16) '掛線
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlDash
            End With
            wAc.PageSetup.PrintArea = "$A:$M$" & saKi + 16 '印刷範囲を最終行+1行まで指定
        End If
    Next
    
    No_syokyo
End Sub
Sub main1_kairyo() '追加[1]部分。ヘッダー、フッターをつけて印刷の向きを横に
    With wM1.PageSetup
        .CenterHeader = "&A" 'シート名
        .CenterFooter = "&P" 'ページ数
        .Orientation = xlPortrait
    End With

End Sub

Sub No() 'A列作成
    wM.Range("A2").FormulaR1C1 = "1"
    wM.Range("A3").FormulaR1C1 = "2"
    wM.Range("A2:A3").AutoFill Destination:=wM.Range("A2:A" & saiGo)
    With wM.Range("A1")
        .FormulaR1C1 = "No."
        .Font.Bold = True
        .Interior.ThemeColor = xlThemeColorAccent1
        .Interior.TintAndShade = 0.799981688894314
    End With
End Sub

Sub No_syokyo() '課題[2]部分のA列並べ替え&消去
    With wM
        .Range("A1:G" & saiGo).Sort key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
        .Range("A1:A" & saiGo).ClearContents
        .Range("A1").Interior.Pattern = xlNone
        .Range("A1").Font.Bold = False
        .Activate
    End With
End Sub

Sub syokyo()
    Application.DisplayAlerts = False
    For Each w In Worksheets
        If InStr(w.Name, "main") = 0 Then
            w.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

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

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

2020-12-27 15:40:45 加藤さんからの投稿です。

予習ではこのように書きました。
自動記録コードの編集に課題がありそうですが、解説を楽しみに拝見いたします。

 Sub yoshu8()
    Dim sh As Worksheet
    Set sh = Worksheets("main")
    Dim gyo As Long
    Dim gyomx As Long
    gyomx = sh.Range("B65536").End(xlUp).Row
    For gyo = 2 To gyomx
        sh.Range("A" & gyo).Value = gyo - 1
    Next
    Selection.AutoFilter
    sh.AutoFilter.Sort.SortFields.Clear
    sh.AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "B1:B317"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With sh.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    sh.AutoFilter.Sort.SortFields.Clear
    sh.AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "A1:A317"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        sh.AutoFilter.Sort.SortFields.Clear
    sh.AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "A1:A317"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With sh.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub 

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

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

2020-12-26 01:42:34 加藤さんからの投稿です。

予習のコードです。
メールを読むのはこれからですが、H列に合計を入れるところや罫線は、もっと効率の良い方法があるのではと楽しみです。

Sub day7yoshu()
    Delete_Sheets
    Dim shFm As Worksheet
    Dim InFm As Long
    Dim InFmMx As Long
    Dim st As String
    Dim shTo As Worksheet
    Dim dt As Date
    Dim gyo As Long
    Set shFm = Worksheets("main")
    InFmMx = shFm.Range("B65536").End(xlUp).Row
    For InFm = 2 To InFmMx
        If st <> shFm.Range("B" & InFm).Value Then
            Debug.Print shFm.Range("B" & InFm).Value
            st = shFm.Range("B" & InFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
            gyo = 16
        End If
        If shFm.Range("G" & InFm).Value < 0 Then
            '貸方に負の数が入らないよう、右辺はマイナスとした。
            shTo.Range("J" & gyo).Value = -shFm.Range("G" & InFm).Value
        Else
            shTo.Range("I" & gyo).Value = shFm.Range("G" & InFm).Value
        End If
        dt = shFm.Range("C" & InFm).Value
        shTo.Range("H" & gyo).Value = shFm.Range("F" & InFm).Value
        shTo.Range("E" & gyo).Value = shFm.Range("D" & InFm).Value
        shTo.Range("F" & gyo).Value = shFm.Range("E" & InFm).Value
        shTo.Range("B" & gyo).Value = Right(Year(dt), 2)
        shTo.Range("C" & gyo).Value = Month(dt)
        shTo.Range("D" & gyo).Value = Day(dt)
        If gyo = 16 Then
            shTo.Range("K" & gyo).Value = shTo.Range("I" & gyo).Value - shTo.Range("J" & gyo).Value
        ElseIf gyo > 16 Then
            shTo.Range("K" & gyo).Value = shTo.Range("I" & gyo).Value - shTo.Range("J" & gyo).Value + shTo.Range("K" & gyo - 1).Value
        End If
        shTo.Range("B" & gyo & ":K" & gyo).Select
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        gyo = gyo + 1
    Next
End Sub

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

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

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

2020-12-24 00:24:44 加藤さんからの投稿です。

予習段階で作成したコードです。

よく迷うのですが、変数の名前はどんな点を考慮して付ければよいでしょうか。他のところで説明されていましたらすみません。

一応、ハンガリアン記法の動画は拝見しました。

  Sub day6yoshu()
    Delete_Sheets
    Dim shFm As Worksheet
    Dim InFm As Long
    Dim InFmMx As Long
    Dim st As String
    Dim shTo As Worksheet
    Dim dt As Date
    Dim gyo As Long
    Set shFm = Worksheets("main")
    InFmMx = shFm.Range("B65536").End(xlUp).Row
    For InFm = 2 To InFmMx
        If st <> shFm.Range("B" & InFm).Value Then
            Debug.Print shFm.Range("B" & InFm).Value
            st = shFm.Range("B" & InFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
            gyo = 16
        End If
        If shFm.Range("G" & InFm).Value < 0 Then
            shTo.Range("J" & gyo).Value = shFm.Range("G" & InFm).Value
        Else
            shTo.Range("I" & gyo).Value = shFm.Range("G" & InFm).Value
        End If
        dt = shFm.Range("C" & InFm).Value
        shTo.Range("H" & gyo).Value = shFm.Range("F" & InFm).Value
        shTo.Range("E" & gyo).Value = shFm.Range("D" & InFm).Value
        shTo.Range("F" & gyo).Value = shFm.Range("E" & InFm).Value
        shTo.Range("B" & gyo).Value = Right(Year(dt), 2)
        shTo.Range("C" & gyo).Value = Month(dt)
        shTo.Range("D" & gyo).Value = Day(dt)
        gyo = gyo + 1
    Next
End Sub


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

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

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

2020-12-21 23:51:05 加藤さんからの投稿です。

4日目を終えて予習で書いたコードです。

発展編のフォローアップを進めていると、基礎編及び基礎編のフォローアップで学んだことがすごく効いていて、発展編1はまさに基礎編の応用なのだと実感しております。
5日目のメールは追って確認させていただきます。今後も楽しみにしております。

Sub day4yoshu()
    Delete_Sheets
    Dim shFm As Worksheet
    Dim InFm As Long
    Dim InFmx As Long
    Dim st As String
    Dim shTo As Worksheet
    Set shFm = Worksheets("main")
    InFmx = Range("B65536").End(xlUp).Row
    For InFm = 2 To InFmx
        If shFm.Range("B" & InFm).Value <> shFm.Range("B" & InFm - 1).Value Then
            Debug.Print shFm.Range("B" & InFm).Value
            st = shFm.Range("B" & InFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
        End If
    Next
End Sub 


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

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

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

2020-12-20 12:48:26 受講生さんからの投稿です。

何とかこの回まではできました。次回の予習も行います。

前回の予習では、私はIf文にAndで”main”と”main2″を設定しましたが、

解説のIf Left(sh.Name, 4) &lt;> “main” Then
はスマートですね。

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

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

2020-11-29 11:33:21 らりおさんからの投稿です。

基礎編のフォローアップでも紹介されてた考え方ですね!発展編1でも、基礎編で手と頭を使って何度も何度も学んだ「道具の使い方」というのは、重要かつ汎用性の高いものだということを改めて実感しました。( ..)φ

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

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

2020-11-22 11:02:46 らりおさんからの投稿です。

【宿題】お世話になります。課題を提出致します。
添削宜しくお願い致します。

Option Explicit
    Public Moto As Worksheet
    Public Saki As Worksheet
    Public saigo As Long
    Public gyo As Long
    Public Tenki As Worksheet
Sub denpyosakusei()
    Dim hiduke As Date
    Dim kakidasi As Long
    Dim kingaku As Long
    Dim zandaka As Long
    
    Set Saki = Workbooks("s09_homework").Worksheets("main1")
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    denpyosyokyo
    
    '作成前のシート"main"の並べ替え
    id
    hiduke_narabe
    b_narabe
    
    'シート作成&転記
    For gyo = 2 To saigo
        If Moto.Range("B" & gyo).Value &lt;> Moto.Range("B" & gyo - 1).Value Then
            kakidasi = 16
            zandaka = 0
            Saki.Copy After:=Sheets(Worksheets.Count)
            Set Tenki = ActiveSheet
            Tenki.Name = Moto.Range("B" & gyo).Value
        End If
        hiduke = Moto.Range("C" & gyo).Value
        kingaku = Moto.Range("G" & gyo).Value
        Tenki.Range("B" & kakidasi).Value = Right(Year(hiduke), 2)
        Tenki.Range("C" & kakidasi).Value = Month(hiduke)
        Tenki.Range("D" & kakidasi).Value = Day(hiduke)
        Tenki.Range("E" & kakidasi & ":F" & kakidasi).Value = Moto.Range("D" & gyo & ":E" & gyo).Value
        Tenki.Range("H" & kakidasi).Value = Moto.Range("F" & gyo).Value
        Select Case kingaku
            Case Is >= 0
                Tenki.Range("I" & kakidasi).Value = kingaku
            Case Else
                Tenki.Range("J" & kakidasi).Value = kingaku
        End Select
        zandaka = zandaka + kingaku
        Tenki.Range("K" & kakidasi).Value = zandaka
        
        '掛線
        If Moto.Range("B" & gyo).Value &lt;> Moto.Range("B" & gyo + 1).Value Then
            With Tenki.Range("B16" & ":K" & kakidasi)
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlThin
            End With
            If zandaka &lt; 0 Then  '最終残高がマイナスの時、タブの色を赤にするアレンジ
                Tenki.Tab.Color = vbRed
            End If
        End If
        kakidasi = kakidasi + 1
    Next
    
    Moto.Select 'シート"main"を元に戻す
    id_narabe
    Moto.Columns("A:A").ClearContents
End Sub
Sub id()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Range("A1").Value = "No."
    For gyo = 2 To saigo
        Moto.Range("A" & gyo).Value = gyo - 1
    Next
End Sub
Sub b_narabe()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Sort.SortFields.Clear
    Moto.Sort.SortFields.Add Key:=Range("B2:B" & saigo)
    With Moto.Sort
        .SetRange Range("A1:G" & saigo)
        .Header = xlYes
        .Apply
    End With

End Sub
Sub id_narabe()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Sort.SortFields.Clear
    Moto.Sort.SortFields.Add Key:=Range("A2:A" & saigo)
    With Moto.Sort
        .SetRange Range("A1:G" & saigo)
        .Header = xlYes
        .Apply
    End With

End Sub
Sub hiduke_narabe()
    Set Moto = Workbooks("s09_homework").Worksheets("main")
    saigo = Moto.Range("B" & Moto.Rows.Count).End(xlUp).Row
    
    Moto.Sort.SortFields.Clear
    Moto.Sort.SortFields.Add Key:=Range("C2:C" & saigo)
    With Moto.Sort
        .SetRange Range("A1:G" & saigo)
        .Header = xlYes
        .Apply
    End With

End Sub

Sub denpyosyokyo()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If InStr(ws.Name, "main") = 0 Then
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

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

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

2020-10-21 05:40:40 たかちゃんさんからの投稿です。

【感想】
発展編1を終了後、一通り復習して戻ってきました。
基礎編から初めてちょうど2ヶ月経ちましたが、自分でも驚くほど上達しました。良い先生に勉強方法からきちんと指導して貰えると、こんなにも違うんですね。今、このタイミングで本当に良い教材に会えて良かったと心から思います。現在、某国で特に仕事もしていないので、直ぐに実践に生かせず残念ですが。。今回の経験を通じてプログラミング能力だけでなく、自信もついてきました。(^^)

今のレベルはと言うと、一番苦戦したカレンダー課題も(前回から日が空いて記憶も薄れている状態でも)多少考えながらリラックスして、なんとか動くプログラムが書ける状態までになりました。

業務では社内ヘルプ、サーバー部門でのエンジニアさんのアシスタント、営業事務&売上管理などを行っていて、エクセルは良く使っていましたが、マクロは自動記録を使っていた程度です。

過去の質問者さんとのやり取りも本当に勉強になりました。良い質問が出尽くしていて、疑問はコメントをチェックするだけで殆ど解決しました。また、「励ましの言葉を下さい」といったコメントに対する先生の回答にも、何度か励まされました。
それでは、そろそろ発展2へ進もうと思います。引き続き宜しくお願いします。

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

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

2020-10-10 18:40:22 ゲストさんからの投稿です。

いつもお世話になっております。
宿題を提出いたします。
添削の方を宜しくお願い致します。
マクロ記録やステップインして確認して作成しました。

伝票作成ボタン等を作成する際に、気になったのがフォームコントロールとActiveXコントロールの違いです。
今回は、フォームコントロールボタンを使いました。
こちらのボタンの方がいい等ありましたら、ご教授お願いしたいです。よろしくお願いいたします。

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

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

2020-10-07 04:42:13 たかちゃんさんからの投稿です。

かなり苦労しましたが、やっとここまで辿り着きました。カレンダー作成の最初の方の動画では模範解答をノートに書いて(写経?!)構造理解に努めました。Do LoopやWith構文、FormulaやDateaddの理解があやふやだったので、とても良い復習になりました。今回のOffsetの使い方も、本当にためになりました。

今回はControlシートで、曜日がA1から縦に日曜日(weekdayの規定値1)、月曜日(weekdayの規定値2)、火曜日(weekdayの規定値3)・・・土曜日(weekdayの規定値7)の順で並んでいる。なので、Offsetと組み合わせて、所定の曜日を見に行くと言うことですね。わずか2行追加でできるなんてびっくりしました。

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

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

2020-09-30 03:19:45 たかちゃんさんからの投稿です。

これは便利ですね。
因みに、macOS環境だと、vbNewLineの代わりにChr(13)を使って動きました。導入編からずっと勉強してきて、これまで”ファイルパスの区切り文字”以外は全てWindowsと一緒でしたが、今回の改行もWindowsと違うようです。
macOSで書いたプログラムをWindowsユーザへ渡す時は、殆ど一緒ですが要注意ですね。。。

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

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

2020-09-28 10:26:51 たかちゃんさんからの投稿です。

【宿題】
いつもお世話になります。課題を提出致します。
どうぞ宜しくお願い致します。

Option Explicit
Dim retsu As String

Public Sub create_denpyo()
write_no
retsu = “b” ‘取引先で並び替え
sort
exe_create_denpyo
retsu = “a” ‘番号で並び替え
sort
End Sub

Private Sub exe_create_denpyo()
delete_denpyo
Dim infoSh As Worksheet
Dim infoGyo As Long
Dim infoGyoMx As Long
Dim shTo As Worksheet
Dim shtoGyo As Long
Dim dt As Date
Dim sKaisha As String

Set infoSh = Worksheets(“main”)
infoGyoMx = infoSh.Range(“b1048576”).End(xlUp).Row

For infoGyo = 2 To infoGyoMx
If sKaisha &lt;> infoSh.Range(“b” & infoGyo).Value Then
If infoGyo &lt;> 2 Then
keisen
End If
Worksheets(“main1”).Copy after:=Worksheets(Worksheets.Count)
Set shTo = ActiveSheet
sKaisha = infoSh.Range(“b” & infoGyo).Value
shTo.Name = sKaisha
shtoGyo = 16

End If
‘データ転記
shTo.Range(“e” & shtoGyo).Value = infoSh.Range(“d” & infoGyo).Value
shTo.Range(“f” & shtoGyo).Value = infoSh.Range(“e” & infoGyo).Value
shTo.Range(“h” & shtoGyo).Value = infoSh.Range(“f” & infoGyo).Value
If infoSh.Range(“g” & infoGyo).Value > 0 Then
shTo.Range(“i” & shtoGyo).Value = infoSh.Range(“g” & infoGyo).Value
Else
shTo.Range(“j” & shtoGyo).Value = infoSh.Range(“g” & infoGyo).Value
End If
If shtoGyo = 16 Then
shTo.Range(“k” & shtoGyo).Value = infoSh.Range(“g” & infoGyo).Value
Else
shTo.Range(“k” & shtoGyo).Value = infoSh.Range(“g” & infoGyo).Value + shTo.Range(“k” & shtoGyo).Offset(-1).Value
End If
dt = infoSh.Range(“c” & infoGyo).Value
shTo.Range(“b” & shtoGyo).Value = Right(Year(dt), 2)
shTo.Range(“c” & shtoGyo).Value = Month(dt)
shTo.Range(“d” & shtoGyo).Value = Day(dt)
shtoGyo = shtoGyo + 1
Next
keisen
End Sub

Public Sub delete_denpyo()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If Left(ws.Name, 4) &lt;> “main” Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

Private Sub keisen()
Dim inMx As Long
inMx = Range(“b1048576”).End(xlUp).Row

With Range(“B16:K” & inMx + 1)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
End With
End Sub

Private Sub sort()
Dim inMx As Long
inMx = Range(“b1048576”).End(xlUp).Row

Range(retsu & “1”).Select
With ActiveWorkbook.Worksheets(“main”).sort.SortFields
.Clear
.Add _
Key:=Range(retsu & “2:” & retsu & inMx), _
Order:=xlAscending
End With
With ActiveWorkbook.Worksheets(“main”).sort
.SetRange Range(“A1:G” & inMx)
.Header = xlYes
.Apply
End With
End Sub

Private Sub write_no()
Dim inGyo As Long
Dim inMx As Long
inMx = Range(“b1048576”).End(xlUp).Row

Range(“a1”).Value = “No.”
For inGyo = 2 To inMx
Range(“a” & inGyo).Value = inGyo – 1
Next

End Sub

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

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

2020-09-26 06:08:20 たかちゃんさんからの投稿です。

最後のA列に降った番号並び替えで、すでにワークシートが指定されているので
shFm.Activateを最後に入れなくても動きましたが。やっと一通りできました。(^^)
自分で考えたマクロは罫線を1行1行引いたり、動けば良いや的なマクロでした。
見本解答は、思いもつかない方法で、とても勉強になりました。


Sub bango_narabikae()
Dim saigo As Long
saigo = Worksheets(“main”).Range(“b1048576”).End(xlUp).Row

Range(“A1”).Select
ActiveWorkbook.Worksheets(“main”).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(“main”).Sort.SortFields.Add
 Key:=Range(“A2:A” & saigo), _
Order:=xlAscending

With ActiveWorkbook.Worksheets(“main”).Sort
.SetRange Range(“A1:G” & saigo)
.Header = xlYes
.Apply
End With
End Sub

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

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

2020-09-25 03:17:45 たかちゃんさんからの投稿です。

伝票作成は、0から作成しようとすると一瞬不安になりましたが、落ち着いてゆっくりでしたが書けました!
恐らく仕事で、「初めて作成する物」だったり「もし作成出来なかったらどうしよう?」みたいな環境だと
パニックになってしまいそうですが・・・。
今回は、見本と1行づつ見比べた所、ほぼ同じようにかけて満足です。

3つ疑問が出来たので、質問させて下さい。

【1つ目】Setで設定する位置について。
これは、Dim 〇〇と全部宣言を書いたあとで、Set〜と書くのと、
Dim shFm as worksheet と書いた後に、直ぐにSet〜と書くのでは
どちらの書き方が推奨というのはありますか?(どちらでも動きますが、気になったので。)
Set shFm = Worksheets(“main”)


【2つ目】dt = shFm.Range(“C” & lnFm).Valueの設定する位置について。
この↓の記述の直前に設置した方が良いのか?、For lnFm = 2 To lnFmMxの直後に書いた方が良いのか?
迷いました。結局、動くので同じなんですが、設定するのは動作に影響が出ない範囲でなるべく上の方がいいのかなぁと
一瞬思ったんですが、推奨する位置とかありますか。

shTo.Range(“B” & lnTo).Value = Right(Year(dt), 2)
shTo.Range(“C” & lnTo).Value = Month(dt)
shTo.Range(“D” & lnTo).Value = Day(dt)

【3つ目】書いているとついつい、見やすいように空白行を入れてしまうことがあります。
見本を見ると、タブで横にはずれているものの、殆ど詰めて書いてありました。
空白行は、こんな時以外は入れない方が良いなどありますか?

先生の講座は本当に楽しいです。
最初は伝票が作れたら満足って思っていましたが、今では密かに講座を全制覇目指すことも可能じゃないか?と
思いはじめました。(^^;
本当に良い講座に出会えました。

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

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

2020-09-24 09:34:20 たかちゃんさんからの投稿です。

Application.DisplayAlerts は、変数宣言後にFalseと設定
プログラムの終わりにTrueと設定し元に戻すのですね。

最初に解説をよく見ないで最後に、Application.DisplayAlerts を設定し
あれ効かない?!と焦って、ネットで暫く調査していました。
しかも運が悪いことに、2016年当時の某サイトの投稿でExcel for 2016だとDisplay Alertsは効かないと書いてある投稿を見て、回避策はないものか暫くさがしていました。。。
しかし、セミナーの動作確認済みデータを確認した所、正常動作。
改めて確認した所、単純な設定ミスでした。
自分はmacOS版のエクセルを使っているので、少し動作がおかしいと
直ぐにmacOS版だから動作が変なのか?!と疑ってしまう癖があって反省です。(^^;

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

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

2020-09-13 18:33:47 受講生さんからの投稿です。

小川さん いつもお世話になっております。

下記課題を提出します。添削のほどよろしくお願いいたします。

追記:
A列のデータを初期化するやり方はわかりましたが、課題1の印刷設定がいまいちわかりませんでした。
とりあえず、googleで調べながらヘッダーにシート名、ヘッダーに番号を挿入、といった設定をしました。

Option Explicit
'全体処理
Sub Main()
    Denpyyo_Delete
    Print_Set
    No_Add
    Torihikisaki_Asccending_Order
    Denpyo_Create
    No_Asccending_Order
    No_Delete
End Sub

'取引先毎に伝票作成
Sub Denpyo_Create()
    Denpyyo_Delete
    Dim WFm As Worksheet
    Dim WTo As Worksheet
    Dim CFm As Long
    Dim CFmMax As Long
    Dim CName As String
    Dim CSum As Long
    Dim Cnt As Long
    Dim Dt As Date
    Set WFm = Worksheets("main")
    CFmMax = WFm.Range("B65536").End(xlUp).Row
    Cnt = 16
    
    For CFm = 2 To CFmMax
        If CName &lt;> WFm.Range("B" & CFm).Value Then
            If CFm &lt;> 2 Then
                Denpyo_DrawLine
            End If
            
            Cnt = 16
            CName = WFm.Range("B" & CFm).Value
            Sheets("main1").Copy After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = CName
            Set WTo = ActiveSheet
        End If
            
        WTo.Range("H" & Cnt).Value = WFm.Range("F" & CFm).Value
        WTo.Range("E" & Cnt).Value = WFm.Range("D" & CFm).Value
        WTo.Range("F" & Cnt).Value = WFm.Range("E" & CFm).Value
                
        Dt = WFm.Range("C" & CFm).Value
        
        WTo.Range("B" & Cnt).Value = Right(Year(Dt), 2)
        WTo.Range("C" & Cnt).Value = Month(Dt)
        WTo.Range("D" & Cnt).Value = Day(Dt)
        
        CSum = WFm.Range("G" & CFm).Value
        If CSum &lt; 0 Then
            WTo.Range("J" & Cnt).Value = CSum
        Else
            WTo.Range("I" & Cnt).Value = CSum
        End If
        WTo.Range("K" & Cnt).Value = WTo.Range("K" & Cnt - 1).Value + CSum
        Cnt = Cnt + 1
    Next
    Denpyo_DrawLine
    
End Sub
'mainシートのNoを追加
Sub No_Add()
    Dim WFm As Worksheet
    Dim CFmMax As Long
    Set WFm = Worksheets("main")
    CFmMax = WFm.Range("B65536").End(xlUp).Row
    
    WFm.Range("A1").Value = "No"
    WFm.Range("A2").FormulaR1C1 = "1"
    WFm.Range("A3").FormulaR1C1 = "2"
    WFm.Range("A2:A3").AutoFill Destination:=WFm.Range("A2:A" & CFmMax)
End Sub
'取引先名称を昇順
Sub Torihikisaki_Asccending_Order()
    Dim WFm As Worksheet
    Dim CFmMax As Long
    Set WFm = Worksheets("main")
    CFmMax = WFm.Range("B65536").End(xlUp).Row
    
    WFm.Range("A1:G" & CFmMax).Sort _
    Key1:=WFm.Range("B1"), _
    Order1:=xlAscending, _
    Header:=xlYes

End Sub
'NOを昇順
Sub No_Asccending_Order()
    Dim WFm As Worksheet
    Dim CFmMax As Long
    Set WFm = Worksheets("main")
    CFmMax = WFm.Range("B65536").End(xlUp).Row
    
    WFm.Range("A1:G" & CFmMax).Sort _
    Key1:=WFm.Range("A1"), _
    Order1:=xlAscending, _
    Header:=xlYes
End Sub

'伝票を削除
Sub Denpyyo_Delete()
    Dim Wks As Worksheet
    Application.DisplayAlerts = False
    
    For Each Wks In Worksheets
        If Left(Wks.Name, 4) &lt;> "main" Then
            Wks.Delete
        End If
    Next Wks
    
    Application.DisplayAlerts = True

End Sub

' 課題2 A列のデータ全て削除
Sub No_Delete()
    Dim WFm As Worksheet
    Set WFm = Worksheets("main")
    WFm.Columns("A:A").ClearContents

End Sub
'伝票の線を引く
Sub Denpyo_DrawLine()
    Dim CFmMax As Long
    CFmMax = ActiveSheet.Range("B65536").End(xlUp).Row
    
    With Range("B16:K" & CFmMax).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & CFmMax).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & CFmMax).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & CFmMax).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & CFmMax).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & CFmMax).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End Sub

'課題[1] プリンター設定のみ
'シート毎に設定すると手間がかかるので最初の型sheet(main1)にて印刷形式を設定
Sub Print_Set()
 
    '印刷設定
    With Worksheets("main1").PageSetup
        .PrintArea = "B:K"  '印刷範囲の設定
        .Zoom = False       '倍率をクリア
        .FitToPagesWide = 1 '横方向に1ページに収める
        .FitToPagesTall = 1 '縦方向に1ページに収める
        .Orientation = xlPortrait  '印刷:縦向き
        .CenterHeader = "&B&A&20"  '中央ヘッダーにsheet名と同じ名前を記載
        .RightHeader = "&D"  '右ヘッダーへ当日日付
        .CenterFooter = "- " & "&P" & " -"  'フッターの設定
    End With
    
    '印刷プレビュー
    'Worksheets("main1").PrintPreview
End Sub

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

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

2020-09-12 15:54:44 受講生さんからの投稿です。


小川先生

お世話になっております。
hiroと申します。

発展編1 フォローメールセミナー 第11回の
追加要件のマクロを作成しました。
問題文を間違って解釈しているかもしれませんが、
添削の程、宜しくお願い致します。

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

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

2020-09-06 22:34:54 受講生さんからの投稿です。

【要確認】添削依頼

小川さん
いつもお世話になっております。

課題が完了したので、添付して送ります。

●下記コード一覧

Option Explicit

Sub main()
No_Create
Torihiki_Ascending_Order
Denpyo_Create
No_Ascending_Order
No_Reset
End Sub

'伝票作成
Sub Denpyo_Create()
Depyo_Delete
Dim WkFm As Worksheet
Dim WkTo As Worksheet
Dim CFm As Long
Dim CFmMax As Long
Dim CTo As Long
Dim DFm As Date
Dim CSum As Long
Dim SName As String

Set WkFm = Worksheets("main")
CFmMax = WkFm.Range("B65536").End(xlUp).Row

For CFm = 2 To CFmMax
    If SName &lt;> WkFm.Range("B" & CFm).Value Then
        '取引先毎にsheetを作成
        CTo = 16
        SName = WkFm.Range("B" & CFm).Value
        Sheets("main1").Copy After:=Sheets(2)
        Sheets("main1 (2)").Name = SName
        Set WkTo = ActiveSheet
    End If
   
   '会計番号、信憑番号を新規作成したsheetへ転記
   WkTo.Range("E" & CTo).Value = WkFm.Range("D" & CFm).Value
   WkTo.Range("F" & CTo).Value = WkFm.Range("E" & CFm).Value
   
   '新規作成したsheetへ取引金額を転記
   CSum = WkFm.Range("G" & CFm).Value
   If CSum > 0 Then
        WkTo.Range("I" & CTo).Value = CSum
   Else
        WkTo.Range("J" & CTo).Value = CSum
   End If
   
   '新規作成したsheetへ西暦、何月、何日を転記
    DFm = WkFm.Range("C" & CFm).Value
    WkTo.Range("B" & CTo).Value = Right(Year(DFm), 2)
    WkTo.Range("C" & CTo).Value = Month(DFm)
    WkTo.Range("D" & CTo).Value = Day(DFm)
    
    '新規作成したsheetへ残高の計算を行う
    WkTo.Range("K" & CTo).Value = WkTo.Range("K" & CTo - 1).Value + CSum
     
   '新規作成したsheetへ罫線を取引数に応じた行数だけ作成
   'Q 僕の場合は下記のように記載。小川さんが解説してる通り、サブプロシージャー作成して分けるべきでしょうか?
    With Range("B" & CTo & ":" & "K" & CTo)
     .Borders(xlEdgeTop).LineStyle = xlContinuous
     .Borders(xlEdgeBottom).LineStyle = xlContinuous
     .Borders(xlEdgeRight).LineStyle = xlContinuous
     .Borders(xlEdgeLeft).LineStyle = xlContinuous
     .Borders(xlInsideVertical).LineStyle = xlContinuous
     .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
   CTo = CTo + 1
Next
End Sub

'sheet「mainの」A列へ番号を記入
Sub No_Create()
Dim CFm As Long
Dim WkFm As Worksheet
Set WkFm = Worksheets("main")
Dim CFmMax As Long
WkFm.Range("A1").Value = "No"
CFmMax = WkFm.Range("B65536").End(xlUp).Row

For CFm = 2 To CFmMax
    WkFm.Range("A" & CFm).Value = CFm - 1
Next

End Sub
'sheet「main」B列を昇順に並び替え
Sub Torihiki_Ascending_Order()
Dim WkFm As Worksheet
Dim CFmMax As Long
Set WkFm = Worksheets("main")
'**取引数が追加された場合を想定して下記の変数を追加**
CFmMax = WkFm.Range("G65536").End(xlUp).Row

 WkFm.Range("A1" & ":" & "G" & CFmMax).Sort _
 Key1:=WkFm.Range("B1"), _
 Order1:=xlAscending, _
 Header:=xlYes
End Sub

'sheet「main」A列を昇順に並び替え
Sub No_Ascending_Order()
Dim WkFm As Worksheet
Dim CFmMax As Long
Set WkFm = Worksheets("main")
'**取引数が追加された場合を想定して下記の変数を追加**
CFmMax = WkFm.Range("G65536").End(xlUp).Row

 WkFm.Range("A1" & ":" & "G" & CFmMax).Sort _
 Key1:=WkFm.Range("A1"), _
 Order1:=xlAscending, _
 Header:=xlYes
End Sub

'main1とmain以外のsheetを削除
Sub Depyo_Delete()
Dim Wks As Worksheet

For Each Wks In Worksheets
    Application.DisplayAlerts = False
    If Left(Wks.Name, 4) &lt;> "main" Then
        Wks.Delete
    End If
Next
    Application.DisplayAlerts = True
End Sub
'念のため最後にA列のシートを初期化(多分これは必要ないと思う。)
Sub No_Reset()
Dim WkFm As Worksheet
Set WkFm = Worksheets("main")
    WkFm.Columns("A:A").ClearContents
End Sub


下記3点質問です

Q1:罫線に関して

取引先毎に罫線を引く作業ですが、あえて私は分けずに書いてみました。罫線に関しては小川さんが解説したとおり、サブプロシージャーに分けたほうがよろしいでしょうか?

Q2:変数名に関して
他のプロシージャーで同じ変数を使っています。
ex:WkFm、WkTo、CFmMax等

別のプロシージャーで同じ変数を使っていると、あまり綺麗ではないと感じています。変数名は異なる名前にしたほうがよろしいでしょうか?

Q3:プロシージャー名に関して
気の利いた名前が思いつかないので、結構適当になりました。
小川さんがプロシージャーの名前を付けるときに意識していることをご教示できればと思います。

以上よろしくお願いいたします。

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

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

2020-07-31 00:59:22 受講生さんからの投稿です。

お世話になります。

罫線のマクロを呼び出すタイミング、難しかったです。
何度かステップインで確認してなんとかできました。

過去のコメント欄を読むのも勉強になりますね。

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

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

2020-07-28 01:50:03 受講生さんからの投稿です。

12309 のコメント失礼いたしました。
一部修正します。
コメント投稿してみましたが、送信前の私のチェックが十分でないために
間違いに気づいて大変恥ずかしく思います。
削除頂けないでしょうか。

仕事でも、このような失敗があります。
チェックを怠ってミスすることや
自分の失言に自分でゲンナリすることもあります。
こうした自分自身も変わりたいです。

Option Explicit
 Sub yoshu01()
'[1]
    Dim shFm As Worksheet
    Dim lnFm As Long
    Dim lnFmMx As Long
    Set shFm = Worksheets("main")
    InFmMx = shFm.Range("C65536").End(xlUp).Row
    For lnFm = 2 To InFmMx
        If shFm.Range("B" & lnFm).Value &lt;> shFm.Range("B" & lnFm + 1).Value Then 'ここで条件を追加しました
            Debug.Print shFm.Range("B" & lnFm).Value
        End If
    Next
    
 End Sub
Sub yoshu02()
'[2]
    Dim shFm As Worksheet
    Dim shTo As Worksheet
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim st As String
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("C65536").End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm).Value &lt;> shFm.Range("B" & lnFm + 1).Value Then
            st = shFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)    'シート追加、シート名の指定しました
            Set shTo = ActiveSheet
            shTo.Name = st
        End If
    Next
    
End Sub
Sub yoshu03()
'[3]
    delete_renshu       'ここにシート削除のプロシージャを追加しました
    Dim shFm As Worksheet
    Dim shTo As Worksheet
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim st As String
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("C65536").End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm).Value &lt;> shFm.Range("B" & lnFm + 1).Value Then
            st = shFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
        End If
    Next
    
End Sub
Sub delete_renshu()
    Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In Worksheets
        If Left(sh.Name, 4) &lt;> "main" Then
            sh.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

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

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

2020-07-26 12:25:21 ゲストさんからの投稿です。

お世話になります。
するどいツッコミ頂いたので(笑)
フォローアップセミナーのうち、最低でも3回に1回は感想を送ります!
言い訳になりますが、今朝ちょうど取り組んでいたところだったのですごくタイムリーでおかしかったです(笑)
ようやく第3回フォローアップセミナーまで進みました。
追加したシートを選択するのに、ActiveSheet.Nameで指定しましたが、問題ないでしょうか?
解答例では、Sheets(“main1 (2)”).Nameでシート名が指定されていました。
課題通り動いています。
こんな質問していいか迷いましたが、少し気になりましたので、よろしくお願いいたします。

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


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

 

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

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

トップへ