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

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

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

2020-05-31 18:47:32 受講生さんからの投稿です。

お世話になります。
今回のセミナーまでのカレンダー作成を何も見ずに1から書き上げてみました。
サンプルコードと違う部分記述やまとめ方をしている部分もいくつかありますので添削していただけると幸いです。

Option Explicit

Dim dt1 As Date
Dim b As Boolean
Sub shCreate()
    
    Dim lnMon As Long
    Dim shTo As Worksheet
    Dim lnMx As Long
    
    Application.ScreenUpdating = False
    lnMx = Worksheets("Summary").Range("A" & Worksheets("Summary").Rows.Count).End(xlUp).Row
    
    Dim dt As Date
    dt = #1/1/2009#
    
    If lnMx > 1 Then
        Worksheets("Summary").Range("A2", "E" & lnMx).ClearContents
        Worksheets("Summary").Range("A2", "E" & lnMx).Interior.Pattern = xlNone
        Worksheets("Summary").Range("A2", "E" & lnMx).Font.ColorIndex = 1
        Worksheets("Summary").Range("A2", "E" & lnMx).Font.Bold = False
    End If
    
    shDelete
    For lnMon = 1 To 12
        Sheets("Summary").Copy After:=Sheets(Worksheets.Count)
        Set shTo = ActiveSheet
        shTo.Name = lnMon & "月"
    Next
    
    Dim c As Long
    c = 1
    Dim ws As Worksheet
    For Each ws In Worksheets
        If Right(ws.Name, 1) = "月" Then
            ws.Select
            dt1 = DateAdd("m", c - 1, dt)
            shKousei
            c = c + 1
        End If
    Next
    Worksheets("Summary").Select
    Application.ScreenUpdating = True
End Sub

Sub shDelete()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Not ws Is Worksheets("Control") Then
            If Not ws Is Worksheets("Summary") Then
                ws.Delete
            End If
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Sub shKousei()
    Dim dt2 As Date
    Dim c As Long
    Dim n As Long
    Dim shSummary
    Set shSummary = Worksheets("Summary")
    Dim shControl
    Set shControl = Worksheets("control")
    Dim lnSumMx
    
    lnSumMx = shSummary.Range("A" & shSummary.Rows.Count).End(xlUp).Row - 1
    
    dt2 = dt1
    c = 0
    
    Dim rgSummary As Range
    Dim rgControl As Range
    
    With Range("A2")
        Do While Month(dt1) = Month(dt2)
            .Offset(c, 0).Value = dt1
            .Offset(c, 1).Value = WeekdayName(Weekday(dt1))
            .Offset(c, 2).Value = #9:00:00 AM#
            .Offset(c, 3).Value = #5:00:00 PM#
            .Offset(c, 4).Formula = "=" & .Offset(c, 3).Address & "-" & .Offset(c, 2).Address
            Holiday
            For n = 0 To 4
                Set rgSummary = shSummary.Range("A2").Offset(lnSumMx + c, n)
                Set rgControl = shControl.Range("A1").Offset(Weekday(dt1), 0)
                rgSummary.Formula = "='" & .Worksheet.Name & "'!" & .Offset(c, n).Address
                With .Offset(c, n)
                    If b = True Then
                        .Interior.ColorIndex = shControl.Range("F2").Interior.ColorIndex
                        .Font.ColorIndex = shControl.Range("F2").Font.ColorIndex
                        .Font.Bold = shControl.Range("F2").Font.Bold
                        rgSummary.Interior.ColorIndex = shControl.Range("F2").Interior.ColorIndex
                        rgSummary.Font.ColorIndex = shControl.Range("F2").Font.ColorIndex
                        rgSummary.Font.Bold = shControl.Range("F2").Font.Bold
                    Else
                        .Interior.ColorIndex = rgControl.Interior.ColorIndex
                        .Font.ColorIndex = rgControl.Font.ColorIndex
                        rgSummary.Interior.ColorIndex = rgControl.Interior.ColorIndex
                        rgSummary.Font.ColorIndex = rgControl.Font.ColorIndex
                    End If
                End With
            Next
            dt1 = DateAdd("d", 1, dt1)
            c = c + 1
        Loop
    End With
End Sub

Sub Holiday()
    b = False
    Dim c As Long
    For c = 2 To 18
        If dt1 = Worksheets("Control").Range("C" & c).Value Then
            b = True
        End If
    Next
End Sub

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

[12147]基礎講座第3章3 – Left関数、Mid関数、Right関数

2020-05-31 06:19:53 受講生さんからの投稿です。

初歩的な質問です。
”A1”というのを入力するのに、” と A の二文字は
shift キーを都度押しながら入力しているので時間がかかるのですが
簡単に入力できる方法はないでしょうか?
宜しくお願いします。

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

[12144]エクセルマクロの全体像

2020-05-28 19:40:56 受講生さんからの投稿です。

とてもためになりました。

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

[12138]エクセルマクロ・VBA発展編1フォローアップミニセミナーNo.03

2020-05-27 01:25:36 福島さんからの投稿です。

小川先生
いつも大変お世話になっております。
みなさまとはレベルが違う質問で失礼いたします。

 ◆【 テキスト中級編 】が、
どの講座の どのテキストか? を教えて下さい。

  ( 解答例メールに【 テキスト中級編第5章 参照】の記載があります )

・導入編、基礎編、発展編1をざっと見て、
   自動記録を使い、業務用のツール作成を試行錯誤してます。
 ・ファイルの操作について知りたく、
  このセミナーに取りかかろうとしてます。

 ・必要な項目を、立ち戻って深掘りしたく
  【中級編】がどの講座にあたるのかを教えてください。

以上、宜しくお願いいたします。

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

[12130]基礎講座第1章12 – ドリル

2020-05-24 20:52:08 さざなみさんからの投稿です。

練習問題8について質問です。Dimの2行のあとの式の私の解答は、Range(“C4”)=Range(“B4”)+Range(“B4”)*zeiritu でした。うっかり .Valueを入れ忘れましたがマクロが正常に動きました。.Value が入らないと何が違うのでしょうか。

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

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

2020-05-23 14:54:20 受講生さんからの投稿です。

お世話になっております。
伝票作成マクロを一通り受講したのち、一から記憶を頼りに作成してみました。
挙動については問題なかったので、あとは不必要な部分やセオリーに反している部分があればご指摘いただけると幸いです。
なお一点、並び替えマクロ(プロシージャ名:sorting)にて自動記述後取捨選択箇所の判断がつかずそのまま活用している為(セミナー内に記載されていた例と同じコードが自動で書かれなかったので・・・)、不要な部分とその判断方法をご教示頂けたら嬉しいです。

Option Explicit

Dim G_retu As String
Public Sub main()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    sheetDelete
    
    writeNo
    
    G_retu = "B"
    sorting
    
    sheetcreat

    G_retu = "A"
    sorting
    
    Aclear
    Worksheets("main").Select
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub


Public Sub sheetDelete()
    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 writeNo()
    Dim ws As Worksheet
    Dim lnFmMx As Long
    Dim ln As Long
    
    Set ws = Worksheets("main")
    lnFmMx = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
    For ln = 2 To lnFmMx
        ws.Range("A" & ln).Value = ln - 1
    Next
End Sub
    
    
Private Sub sorting()
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    Range(G_retu & "1").Select
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Add2 Key:=Range(G_retu & "1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("main").Sort
        .SetRange Range("A2:G" & lnMx)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub


Private Sub sheetcreat()
    Dim shFm As Worksheet
    Dim shTo As Worksheet
    
    Dim lnFm As Long
    Dim lnFmMx As Long
    
    Dim lnTo As Long
    
    Dim strName As String
    Dim dt As Date
    
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("B" & shFm.Rows.Count).End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If strName <> shFm.Range("B" & lnFm).Value Then
            If lnFm > 2 Then
                keisen
            End If
            strName = shFm.Range("B" & lnFm).Value
            Debug.Print strName
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = strName
            lnTo = 16
        End If
        dt = shFm.Range("C" & lnFm).Value
        shTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
        shTo.Range("C" & lnTo).Value = Month(dt)
        shTo.Range("D" & lnTo).Value = Day(dt)
        
        shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnFm).Value
        shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnFm).Value
        shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnFm).Value
        
        Select Case shFm.Range("G" & lnFm).Value
            Case Is > 0
                shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnFm).Value
            Case Else
                shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnFm).Value
        End Select
        If lnTo = 16 Then
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value
        Else
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value + shTo.Range("K" & lnTo).Offset(-1, 0).Value
        End If
        
        lnTo = lnTo + 1
    Next
    keisen
End Sub

Private Sub keisen()
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    Range("B16:K" & lnMx).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
End Sub

Private Sub Aclear()
    Dim lnMx
    lnMx = Worksheets("main").Range("A" & Worksheets("main").Rows.Count).End(xlUp).Row
    Debug.Print lnMx
    Worksheets("main").Range("A2:A" & lnMx).Clear
End Sub


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

[12115]複数条件を組み合わせた条件分岐

2020-05-23 10:49:27 受講生さんからの投稿です。

お世話になっております。
動画を見る前に、まず自分でやってみて、答え合わせに動画を見ています。
問題[1]は、出来たのですが、問題[2]でif文を重ねることが思いつかず、下記コードになりました。(>と>=も間違っています)
何度「構文エラー」が出て、修正してやっと出来た!と思い動かしてみたところ、すべて”不合格”となってしまいました。
ギブアップして、動画を見てif文を重ねるのだと納得しました。

時間がかかりますが、何度も演習問題を解くことが、自分の力になると信じて頑張ります。

今後もどうぞよろしくお願いいたします。



Sub gouhi()
Dim gyo
For gyo = 2 To 11
If Range(“C” & gyo).Value = “男性” & Range(“D” & gyo).Value > 80 Then
Range(“H” & gyo).Value = “合格”
ElseIf Range(“C” & gyo).Value = “女性” & Range(“D” & gyo).Value > 70 Then
Range(“H” & gyo).Value = “合格”
Else
Range(“H” & gyo).Value = “不合格”
End If
Next



End Sub

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

[12114]エクセルマクロの全体像

2020-05-22 07:15:22 受講生さんからの投稿です。

分かりやすかったです。もう一度VBAを学習しよう、という気持ちが強くなりました

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

[12106]エクセルマクロ・VBAを利用するための推奨設定 – VisualBasicEditorの初期設定

2020-05-20 01:09:31 受講生さんからの投稿です。

教えてもらわないとわからない点が多くあり、勉強になりました。
ありがとうございました。

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

[12105]複数条件を組み合わせた条件分岐

2020-05-19 23:02:17 受講生さんからの投稿です。

いつもお世話になっております。この問題はできたのですが、多少自分のコードは無駄が多いですね汗。

「ElseIf Range(“E” & gyo).Value = “平成” Then」ここはelse使えば、よかったんですね。

あと質問なんですが、”昭和”の箇所はRange(“E2”).Valueにも置き換えられると思うのですが、直接文字列を入力したほうが動作的には軽くなるのでしょうか?

Sub shouwheisei()
    Dim gyo
    For gyo = 2 To 11
        If Range("E" & gyo).Value = "昭和" Then
            Range("G" & gyo).Value = Range("F" & gyo).Value + 25 + 1900
        ElseIf Range("E" & gyo).Value = "平成" Then
            Range("G" & gyo).Value = Range("F" & gyo).Value - 12 + 2000
        End If
    Next
End Sub

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

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

2020-05-19 20:28:35 受講生さんからの投稿です。

お世話になっております。
添削を宜しくお願いいたします。
ここまで取り組んだことで、仕事でマクロを使ったツール作成ができるようになっていて、大変うれしいです。
作成していて2点疑問があり、以下ご教示頂きたいです。
何卒宜しくお願いいたします。

1,workbookとworksheetを格納した変数で書くことはできないのでしょうか。
今回のマクロは別のExcelブック間を行き来しないので良いのですが発生する場合、変数で記載出来ればいいなと思って書いたらエラーとなってしまいました。
workbookやworksheetの書き方の規則はどんなものがあるのでしょうか。
Dim shF As Worksheet
Dim boF As Workbook
Set boF = Workbooks(“s09_homework.xls”)
Set shF = Worksheets(“main”)

動いた
shF.Range(“A1”).Value = “No.”
Workbooks(“s09_homework.xls”).Worksheets(“main”).Range(“A1”).Value = “No.”
boF.Worksheets(“main”).Range(“A1”).Value = “No.”

動かない
boF.shF.Range(“A1”).Value = “No.” ←このように記載できればと思っていました。
Workbooks(“s09_homework.xls”).shF.Range(“A1”).Value = “No.”

2,kaishiのSubプロシージャですが、最後mainシートのA1を選択された状態で終了したいとしたとき、
shF.Range(“A1”).Select
とだけ書くとエラーとなり、
shF.Activate
といれるとちゃんと動くようになりました。
こちらはselectしたいのであれば一度そのシートをActivateの状態にしないとだめというルールなのですか?

何卒宜しくお願い致します。

Option Explicit
Private shF As Worksheet
Private shT As Worksheet
Private lnfz As Long
Private r As String

Public Sub kaishi()
    Set shF = Worksheets("main")
    lnfz = shF.Range("B" & Rows.Count).End(xlUp).Row
    
    sakuzyo
    Aretu
    r = "B"
    narabikae
    sakusei
    r = "A"
    narabikae
    shF.Range("A1:A" & lnfz).ClearContents
 ’なぜ一度シートをactiveteしなければshF.Range("A1").Selectが動かないのか
    shF.Activate
    shF.Range("A1").Select
End Sub

Private Sub Aretu()
    Dim boF As Workbook
    
    Set boF = Workbooks("s09_homework.xls")
'    Set shF = Worksheets("main")
'    lnFz = shF.Range("B" & Rows.Count).End(xlUp).Row
    
'    動く
'    shF.Range("A1").Value = "No."
'    Workbooks("s09_homework.xls").Worksheets("main").Range("A1").Value = "No."
'    boF.Worksheets("main").Range("A1").Value = "No."
    
'    動かない
'    boF.shF.Range("A1").Value = "No."
'    Workbooks("s09_homework.xls").shF.Range("A1").Value = "No."

    shF.Range("A1").Value = "No."
    shF.Range("A2").Value = 1
    shF.Range("A2").AutoFill Destination:=Range("A2:A" & lnfz), Type:=xlFillSeries

End Sub

Private Sub narabikae()
    
'    Set shF = Worksheets("main")
'    lnFz = shF.Range(r & Rows.Count).End(xlUp).Row
    
    With shF.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range(r & "2:" & r & lnfz), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
        .SetRange Range("A1:G" & lnfz)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub sakusei()
    Dim gyo As Long
    Dim saki As Long
    Dim d As Long
    Dim Kaisya As String
    
    
'    Set shF = Worksheets("main")
'    lnFz = shF.Range("B" & Rows.Count).End(xlUp).Row
    
    For gyo = 2 To lnfz
        If shF.Range("B" & gyo).Value <> Kaisya Then
            If gyo <> 2 Then
                koushisen
                tuika1
            End If
            Kaisya = shF.Range("B" & gyo).Value
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Set shT = Sheets("main1 (2)")
            shT.Name = Kaisya
            saki = 16
        End If
        shT.Range("E" & saki).Value = shF.Range("D" & gyo).Value
        shT.Range("F" & saki).Value = shF.Range("E" & gyo).Value
        shT.Range("H" & saki).Value = shF.Range("F" & gyo).Value
        If shF.Range("G" & gyo).Value > 1 Then
            shT.Range("I" & saki).Value = shF.Range("G" & gyo).Value
        Else
            shT.Range("J" & saki).Value = shF.Range("G" & gyo).Value
        End If
        If saki = 16 Then
            shT.Range("K" & saki).Value = shF.Range("G" & gyo).Value
        Else
            shT.Range("K" & saki).Value = shF.Range("G" & gyo).Value + shF.Range("G" & gyo).Offset(-1).Value
        End If
        d = shF.Range("C" & gyo).Value
        shT.Range("B" & saki).Value = Format(d, "yy")
        shT.Range("C" & saki).Value = Format(d, "mm")
        shT.Range("D" & saki).Value = Format(d, "dd")
        saki = saki + 1
        
    Next
    koushisen
    tuika1
    
End Sub

Public Sub sakuzyo()
    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

Private Sub koushisen()
    Dim lnTz As Long
    
    lnTz = shT.Range("B" & Rows.Count).End(xlUp).Row
    
    With shT.Range("B16:K" & lnTz + 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 = xlThin
        End With
    End With
    shT.Range("B16").Select

End Sub

Private Sub tuika1()
    Dim lnTz As Long
    
    lnTz = shT.Range("B" & Rows.Count).End(xlUp).Row
    
    Application.PrintCommunication = False
    With shT.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    shT.PageSetup.PrintArea = "$B:$K$" & lnTz + 1
    Application.PrintCommunication = False
    With shT.PageSetup
        .LeftHeader = "&A"
        .CenterFooter = "&D"
    End With
    Application.PrintCommunication = True

End Sub

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

[12092]表を解析して1行のリストを作る、1行のリストを解析して表にする(その1)

2020-05-17 18:17:47 受講生さんからの投稿です。

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

下記のようなコードでもsheet2の解答と同じ結果になりました。解説をみましたが、本当に色々パターンありますね。

Sub hyou()
Dim gyo
Dim gyoshya
Dim furigana

    For gyo = 2 To 27
        If InStr(gyoshya, Range("A" & gyo).Value) > 0 Then
        
        Else
            gyoshya = gyoshya & "," & Range("A" & gyo).Value
            furigana = furigana & "," & Range("B" & gyo).Value
        End If
        Range("F2").Value = Mid(gyoshya, 2)
        Range("F3").Value = Mid(furigana, 2)
        
    Next   
End Sub

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

[12090]各資料ごとに1番からの番号を割り振る。AutoFill機能より便利なマクロ

2020-05-17 17:52:19 受講生さんからの投稿です。

お疲れ様です。

小川さんのコードはシンプルで読みやすいです。私が書いたコードだとだいぶ無駄がありますね。汗 

下記がコードです。

Sub banngou()
Dim siryou
Dim gyo

    For gyo = 4 To 19
        siryou = Range("C" & gyo).Value

    If InStr(siryou, "A") > 0 Then
        Range("B" & gyo).Value = Replace(Mid(siryou, 3), "A", 1)
    
    ElseIf InStr(siryou, "B") > 0 Then
        Range("B" & gyo).Value = Replace(Mid(siryou, 3), "B", 2)
    
    ElseIf InStr(siryou, "C") > 0 Then
        Range("B" & gyo).Value = Replace(Mid(siryou, 3), "C", 3)
        
    End If

    Next
End Sub


このコードでやってしまうと、仮にA~Zまでを求める場合、パターンが増えるので大変だなぁと思いました。もう少し効率よく書きたいもんです。

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

[12086]発展1講座第5章 – モジュールレベル変数 アクセシビリティ設定

2020-05-16 15:51:58 受講生さんからの投稿です。

フォルダ「hatten_enshu」について、自分で先生の書かれたステップごとにやってみました。お陰様で解答などを参考にしてなんとか自力で理解することができました。
ただ、残念なのは、最後のファイルにEnshu21200_InputData.xlsがありますが、これは伝票番号を転記するところのものです。最終的には他にも入力したデータを表示することになると思いますが、伝票番号の表示した以降のプログラムはどのようになっているのでしょうか。
解説「伝票作成マクロ」を申し込むと、最後までの解説がなされているのでしょうか。
それとも、基礎編の「mihon」に入っているDenpyoCreate.xlsのプログラムを参考にすることになるのでしょうか。

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

[12077]発展1講座第4章 – For Each構文 カンニングペーパー

2020-05-14 16:09:34 受講生さんからの投稿です。

オブジェクト型の変数は、例えば、worksheetを変数に使う場合、
Dim ws as Worksheet
Set ws = worksheets(“Sheet1”)
として定義しています。
しかしながら、
For each構文では
Dim ws as Worksheet
For Each ws In Worksheets
のようなプログラムになっています。
For each構文を使う場合、Set ws = worksheets(“×××”)のように指定しなくてもよろしいのでしょうか。
For Eachを使う場合、特定のworsheetに限定する場合は、Set構文でひもづけしなければならないと考えてよろしいのでしょうか。

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

[12070]発展1講座第5章 – モジュールレベル変数 アクセシビリティ設定

2020-05-12 16:44:07 受講生さんからの投稿です。

一通り、やりました。よくわかりました。私の手元には、申し込み時にダウンロードした「enshu」がありますが、これは、自分で自主学習するのか、それとも、「エクセルマクロ・VBA発展編1フォローアップミニセミナー」を申し込めば、この「enshu」フォルダーのデータを使って、セミナーがきけるのか、のいずかでしょうか。

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

[12066]とびとびに存在するデータを拾って加工する

2020-05-12 10:10:46 Kenさんからの投稿です。

以下のようなプログラムを作ってみたところうまく動きませんでした。
調べてみたところ
motogyo = kai * 3 – 2​ ’★

kai=1
なのに
motogyo=-2
になっています。
これは何故なのでしょうか?

——————————————–
Sub kaitou1()
Dim kai​
Dim motogyo​
Dim listgyo​
motogyo = kai * 3 – 2​ ’★
listgyo = 1​
For kai = 1 To 10​
Range(“C” & listgyo).Value = Range(“A” & motogyo).Value & Range(“A” & motogyo).Value​
listgyo = listgyo + 1​
Next​
End Sub

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

[12065]動的配列3-演習

2020-05-12 04:49:34 Takao Kanekoさんからの投稿です。

2次元配列のところで、UBound/LBoundのサイズの戻り値-最小値・最大値、行・列 あれ、あれ?とすごく理解に苦しみましたが、みなさんの投稿と先生の動画で2次元配列のエラー修正をしている所を見れて、さらにグンと理解が増しました。
おかげさまで、配列でマクロがしている処理のイメージが付くようになりました。転職後なかなか時間が作れずいましたが、これから一気に発展2を学び終わらせたいと思います。ありがとうございます。

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

[12062]商品ごと、年ごとの販売額合計をピボットテーブルのように出力する(その2-2)

2020-05-10 18:38:24 morimotoさんからの投稿です。

小川塾長:いつも詳しい解説ありがとうございます。
現在発展編1学習中です。先日基礎編アドバンス演習18で
詳しい添削していただきありがとうございました。
今回は演習20でまたもsum関数で計算算出するコートができました。
まず商品で並び替えして、商品を転記
そして年→商品で並び返し
最後年が変わる前後でsum関数の始期、終期を出して
式挿入しました。仕事でこのようなsum関数を使う場面が多いので
動画18に続いて自装してみました。添削のほどお願いしたく
よろしくお願いします。

Sub GWtoshinarabiake()
'20200509
'ここでは商品順に並び変え、各商品を転記する
Worksheets("自粛練習").Activate
'商品を転記

Dim tate As Integer
Dim key As String
Dim gyo As Integer
Dim mgyo As Integer

mgyo = Range("a" & Rows.Count).End(xlUp).row
tate = 3
key = ""

'年で並び替え
Call Range("a1" & ":" & "f" & mgyo).Sort( _
           key1:=Range("e2"), order1:=xlAscending, _
           Header:=xlYes)

For gyo = 2 To mgyo
   If key <> Range("e" & gyo).Value Then
      key = Range("e" & gyo).Value
      Range("H" & tate).Value = key
      tate = tate + 1
   End If
Next gyo

End Sub

Sub toshishohinnarabikae()
'年→商品で並び替え
Worksheets("自粛練習").Activate

Dim mgyo As Integer
 mgyo = Range("a" & Rows.Count).End(xlUp).row

 Call Range("a1" & ":" & "f" & mgyo).Sort( _
           key1:=Range("b2"), order1:=xlAscending, _
           key2:=Range("e2"), order2:=xlAscending, _
           Header:=xlYes)
End Sub

Sub GWexecise1()
'sum関数で商品-年ごと算出
Worksheets("自粛練習").Activate

Call GWtoshinarabiake
Call toshishohinnarabikae

Dim gyo As Integer
Dim mgyo As Integer
Dim tate As Integer '転記先のタテ位置
Dim yoko As Integer
Dim key As String  '年 & 商品のkey
Dim key1 As String '年のkey
Dim key2 As String '商品のkey
Dim toshi As String '年
Dim shohin As String '商品
Dim srow As Integer  'sum関数の始期
Dim erow As Integer  'sum関数の終期

mgyo = Range("a" & Rows.Count).End(xlUp).row
tate = 3
yoko = 0
key = ""
key1 = ""
key2 = ""
srow = 2

For gyo = 2 To mgyo
 toshi = Range("b" & gyo).Value
 shohin = Range("e" & gyo).Value
 
  If gyo > 2 Then
     
      If key <> toshi & shohin Then
         key = toshi & shohin
        
          If key1 <> toshi Then 'gyo>2の条件下でkeyが変わりtoshiも変わった             とき
             key1 = toshi
               If key2 <> shohin Then 'gyo>2の条件下でtoshiもshohinも変わっ               たとき
                  erow = gyo - 1
                  Range(Chr(73 + yoko) & tate).Value = "=sum(F" & srow & " : F"         & erow & ")"
                  srow = gyo
                  yoko = yoko + 1
                  tate = 3 '---タテ位置を3にリセット
                  Range(Chr(73 + yoko) & 2).Value = key1 & "年"
                End If
           Else
             'gyo>2の条件下でkeyが変わりshohinが不変のとき
              key2 = shohin
              erow = gyo - 1
              Range(Chr(73 + yoko) & tate).Value = "=sum(F" & srow & " : F" &        erow & ")"
              srow = gyo
              tate = tate + 1 '下へシフト
           End If
   
       End If
       
   Else 'gyo=2のとき
     Range(Chr(73 + yoko) & 2).Value = toshi & "年"
     key = toshi & shohin
   key1 = toshi
     key2 = shohin
  End If

Next gyo
 'For Nextを出た後にラスト分転記
   erow = gyo - 1
   Range(Chr(73 + yoko) & tate).Value = "=sum(F" & srow & " : F" &   erow  & ")"
End Sub

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

[12060]基礎講座第3章9 – 住所情報を分割する(実習)

2020-05-10 17:08:58 タカキさんからの投稿です。

いつもお世話になりありがとうございます。

講義の課題から下記のサブプロシージャを作りました。

Sub MANSIONRENSHUU()
Dim KU
KU = InStr(Range(“C2”), “区”)

Range(“F2”).Value = Left(Range(“C2”), KU)
Range(“G2”).Value = Mid(Range(“C2”), KU + 1, 100)


End Sub
動画では
 Range(“F2”).Value = Left(Range(“C2”).value, KU)
Range(“G2”).Value = Mid(Range(“C2”).value, KU + 1, 100)

というふにleft関数、mid 関数に .value が入りますが、私の回答は間違っているでしょうか?

ご確認よろしくお願いいたします。

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

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

2020-05-09 21:02:37 受講生さんからの投稿です。

小川慶一さん:
返信とご教示頂きありがとうございます。
Publicとprivateの使い方について、
”’モジュールレベル変数をpublicにするのは、他のモジュールからも呼び出したいときです”
”’プロシージャをprivateにするのは、他のモジュールから呼び出されたくないときです”
をしっかり認識できていなかったです。再度動画・テキスト見返し理解することできました。

>作成中はsubプロシージャごと変数へ格納しなければならないので、ちょっとめんどくさいなと感じました
について、部分的に修正しやすいようにsubプロシージャをいくつか分けて作成し、動作を一気に実行するsubプロシージャを作っていますが、
部分的に修正が発生し、部分的に動作確認する場合、「オブジェクト変数またはWithブロック変数が設定されていません」というエラーが出てきてしまいます。
よって、subプロシージャ毎に
‘ Set shFm = Worksheets(“main”)
‘ lnFmMx = shFm.Range(“B” & Rows.Count).End(xlUp).Row
と残しておいているのですが、(部分的に動作確認するときはコメントブロックを外す)
subプロシージャ毎に毎回同じ文言である
‘ Set shFm = Worksheets(“main”)
‘ lnFmMx = shFm.Range(“B” & Rows.Count).End(xlUp).Row
を記載するのは面倒だなと感じました。(コピペなので、そんなに苦ではありませんが)
オプションエクスプレシットと最初に出てくるサブプロシージャの間に変数を宣言して、
さらに格納でき、そのモジュール内の全てのsubプロシージャで利用できれば便利ではないかと思ってしまいました。
試しに
Option Explicit
Dim shFm As Worksheet
Dim shTo As Worksheet
Dim lnFmMx As Long
Set shFm = Worksheets(“main”)
lnFmMx = shFm.Range(“B” & Rows.Count).End(xlUp).Row

sub~

と作成したら、Setの部分で「プロシージャの外では無効です」とエラーがでました。

また、コメント頂いた部分チャレンジしてみました!
いろいろな書き方があるのだと知れてよかったです。コメントありがとうございます。(コード記載しようとしましたが、文字化けしてうまく記載できなかったので、ファイル添付します)

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

[12050]Visual Basic Editorの基本用語と使い方 – 標準モジュールとコードウィンドウ

2020-05-08 17:47:15 ゲストさんからの投稿です。

この丁寧な説明がすごくすごく助かります。
1つずつ、ポイントが動画になっているので、きりがつきやすくて学習しやすいし、分かった分は「済」にできるので混乱せずにすみます。
すごいシステムだなぁありがたいなぁと感激しきりです。無料で教えてくれてありがとうございます。

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

[12040]セル内の文字列から区切り文字を見つけ、その区切り文字の間にある文字列を反映しつつデータ転記する

2020-05-06 14:38:38 受講生さんからの投稿です。

<先ほどの訂正>
一発でできました!
途中書いたコードを確かめながら、間違いがあってもどこが間違っているか手直しして短時間でできました。
ベーシックで躓きもありましたが、コードを印刷して、どこがどう作用しているのか、どんな意図なのかメモを書いて見直していたら、理解が進みました。躓いている方がいたら印刷して自分なりの解説を手書きしてみることをお勧めします。
このやり方で、「mae=ato」「ato=n」もすんなり理解できました。

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

[12034]エクセルマクロ・VBAを利用するための推奨設定 – VisualBasicEditorの初期設定

2020-05-06 12:21:38 受講生さんからの投稿です。

非常にわかりやすいです。ありがとうございます。

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

[12029]表を解析して1行のリストを作る、1行のリストを解析して表にする(その2)

2020-05-06 08:57:19 ゲストさんからの投稿です。

こんにちは。こんな時期なので、仕事にVBAすごく活用して評価されてます。ありがとうございます。

動画と同じような型の転記処理をしているのですが、
転記元は動画と同じ行数程あり、
転記先は10行の表が横にいくつも並んでる状態です。
10行目を終えるとまたすぐ隣の列の1行目から始めたいのですが、どのようにかけばうまくいくでしょうか?
ご教授頂くと幸いです。



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

[12027]セル内の文字列から区切り文字を見つけ、その出現回数+1回だけデータ転記する

2020-05-05 17:12:45 kanekoさんからの投稿です。

理解できない部分があり、フォローアップ ベーシックを読み返してもやはり分からなかったので質問です。
理解できなかったのは、マサラさんが質問した内容と同じ、For next構文の使い方についてです。
以下の通り、自分なりに整理しましたが、認識はあっていますでしょうか。

①今回の使用例
sub tenki()
dim saki
dim kaisu
for kaisu = 0 to 3
WorkSheets(“Sheet2”).range(“B” & saki & “:G” & saki).value=Worksheets(“sheet1”).range(“A2:F2”).value
saki = saki +1
next
end sub

②フォローアップ ベーシック 【動画5】
sub listup()
dim hida
dim migi
migi = 5
for hida = 8 to 17
if range(“C” & hida).value > 100 then
range(“F”&migi).value = range(“A” & hida).value
range(“F”&migi).value = range(“A” & hida).value
range(“F”&migi).value = range(“A” & hida).value
migi = migi + 1
end if
next
end sub

②今までのの使用例は、行や列をある特定の範囲で指定しセルやその範囲を指定するものだったのに対して、
①今回の使用例は、For~Nextの間のコードを繰り返すという使い方であるように考えました。

まず、この考え方は合っていますでしょうか。

また、この使用例は基礎講座で初めて出てきた使い方であるという認識であっていますでしょうか。
私が見逃している場合は教えていただきたいです。復習したいと思います。

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

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

2020-05-05 14:50:30 受講生さんからの投稿です。

いつもお世話になっております。
添削よろしくお願いいたします。
Publicの使い方について、後々修正が必要となったとき、1カ所修正で済むようにと思い、以下のように作成しましたが、逆にやりにくさが出たりするのでしょうか。(作成中はsubプロシージャごと変数へ格納しなければならないので、ちょっとめんどくさいなと感じました)
効果的なPublicの使い方をしているか不安です。
よろしくお願いいたします。

Option Explicit

Public shFm As Worksheet
Public shTo As Worksheet
Public lnFmMx As Long
Sub zikkou()
    Set shFm = Worksheets("main")
    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    sakuzyo
    bango
    narabikae
    sakusei

End Sub


Sub bango()
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim lnFm As Long
    
    shFm.Range("A1").Value = "No."
    For lnFm = 2 To lnFmMx
        shFm.Range("A" & lnFm).Value = lnFm - 1
    Next
End Sub

Sub narabikae()
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    shFm.Sort.SortFields.Clear
    shFm.Sort.SortFields.Add2 _
        Key:=Range("B2:B" & lnFmMx), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With shFm.Sort
        .SetRange Range("A1:G" & lnFmMx)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    shFm.Range("A1").Select
End Sub

Sub sakusei()
'    Set shFm = Worksheets("main")
'    lnFmMx = shFm.Range("B" & Rows.Count).End(xlUp).Row
    
    Dim lnTo As Long
    Dim lnFm As Long
    Dim st As String
    Dim dt As Date
    
    For lnFm = 2 To lnFmMx
        If shFm.Range("B" & lnFm).Value <> shFm.Range("B" & lnFm - 1).Value Then
            If lnFm <> 2 Then
                koushisen
            End If
            st = shFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(2)
            Set shTo = ActiveSheet
            shTo.Name = st
            lnTo = 16
            
        End If
        shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnFm).Value
        shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnFm).Value
        shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnFm).Value
        If shFm.Range("G" & lnFm).Value > 0 Then
            shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnFm).Value
        Else
            shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnFm).Value
        End If
        If lnTo = 16 Then
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value
        Else
            shTo.Range("K" & lnTo).Value = shFm.Range("G" & lnFm).Value + shTo.Range("K" & lnTo).Offset(-1).Value
        End If
        dt = shFm.Range("C" & lnFm).Value
        shTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
        shTo.Range("C" & lnTo).Value = Month(Date)
        shTo.Range("D" & lnTo).Value = Day(dt)
        lnTo = lnTo + 1
    Next
    koushisen
End Sub
Sub koushisen()
    'Set shTo = Worksheets("?{??@??")
    Dim lnToMx As Long
    lnToMx = shTo.Range("B" & Rows.Count).End(xlUp).Row
    With shTo.Range("B16:K" & lnToMx + 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 = xlThin
        End With
    End With

End Sub
Sub sakuzyo()
    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件  [ 動画を見る] 

[12020]エクセルマクロ・VBA発展編1フォローアップミニセミナーNo.10

2020-05-04 21:28:13 受講生さんからの投稿です。

(質問を一度送りましたが、うまく送れていないようですので再送させていただきます。重複していたら申し訳ございません。)
お世話になります。
大変勉強になりました。1点質問があります。
ウォーミングアップ問題の[2]、[3]で文字列を入力するマクロを作成する際に、試しに文字列の前に[’]’を入れ”’001”、”’2010-08-31”と書いて実行してみると、”@”の一文なしでも同じ結果が得られました。この方法でも問題ないでしょうか?

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

[12012]基礎講座第3章9 – 住所情報を分割する(実習)

2020-05-03 13:59:50 受講生さんからの投稿です。

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

キャプチャーのように作成して実行したら、見本通りになりましたが、
こちらも模範解答としてよろしいでしょうか?

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

[12011]補講9-たった1行のコードでセルのデータを配列に投入する

2020-05-02 10:36:24 受講生さんからの投稿です。

早速ご対応頂きありがとうございます。
マイページの購入講座一覧に表示されていることを確認致しました。
ありがとうございました。

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


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

 

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

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

トップへ