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

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

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

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

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

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

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

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

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

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

[12974]条件に一致するデータを別シートに転記する

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

小川慶一 様
この度はご返信ありがとうございます。
早速ですが、エクセルマクロ・VBA基礎編フォローアップ ベーシックの問題に取り掛かりました。
しかし、何度解いてもよくわからない点があります。

★【動画6】 条件に一致するデータを別シートに転記する で例えますと、
Sub ichi()

Dim i As Long
Dim k As Long
k = 9
For i = 4 To 13
If Worksheets(“元データ”).Cells(i, 9) > 100 Then
Worksheets(“要注意リスト”).Cells(k, 3) = Worksheets(“元データ”).Cells(i, 1) ‘ID
Worksheets(“要注意リスト”).Cells(k, 4) = Worksheets(“元データ”).Cells(i, 2) ‘名前
Worksheets(“要注意リスト”).Cells(k, 5) = Worksheets(“元データ”).Cells(i, 9) ‘合計
k = k + 1
End If
Next

End Sub
このような状態です。
解けてはいますし、回答を見ても正しいようなのですが、
k = k + 1の位置にいつも戸惑ってしまうのです。

Dim i As Long
Dim k As Long
k = 9
For i = 4 To 13
If Worksheets(“元データ”).Cells(i, 9) > 100 Then
Worksheets(“要注意リスト”).Cells(k, 3) = Worksheets(“元データ”).Cells(i, 1) ‘ID
Worksheets(“要注意リスト”).Cells(k, 4) = Worksheets(“元データ”).Cells(i, 2) ‘名前
Worksheets(“要注意リスト”).Cells(k, 5) = Worksheets(“元データ”).Cells(i, 9) ‘合計
①k = k + 1
End If
     ②k = k + 1
Next

End Sub

①の状態が正しいというのはif endの中に入れておくというルールのような形で覚えてしまっている状態です。
最初に書いた時点では②の位置に書いてしまうのです。
そしてエラーが出て①の位置に戻しています。
ハナコステップで書いているのですが…何度書いても分かりません。

原因と致しましては、以下のように考えているからだと思うのですが、
そもそも文の読み方が正しくないのでしょうか…
ご教示頂けますと幸いです。

Dim i As Long ‘iを宣言します
Dim k As Long ‘kを宣言します
k = 9 ‘kは9です。
For i = 4 To 13 ‘iは4です(1周目時点)
If Worksheets(“元データ”).Cells(i, 9) > 100 Then ‘もしも元データのi4(1周目時点)が100を超えていたら
Worksheets(“要注意リスト”).Cells(k, 3) = Worksheets(“元データ”).Cells(i, 1) ‘IDをコピー
Worksheets(“要注意リスト”).Cells(k, 4) = Worksheets(“元データ”).Cells(i, 2) ‘名前コピー
Worksheets(“要注意リスト”).Cells(k, 5) = Worksheets(“元データ”).Cells(i, 9) ‘合計コピー
End If ‘K9の値に入れるi4が調べ終わりました
     ②k = k + 1 ‘では次(i=5)に進む前にコピー先のセルも動かします
Next ‘(i=5)に進みます(forに戻ります)

End Sub

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

[12968]基礎講座第4章10 – If文のその他の構文その2

2021-04-14 11:53:11 受講生さんからの投稿です。

基礎編の教材と問題をダウンロードし、seminar date kisoの、kiso(drill含む)までは学習が完了しました。
しかし、DounyuやEnshuなど、他のフォルダの動画が見つかりません。元々ないのでしょうか?
Enshu以外のエクセルはそもそもなんなのか、いつ使うものなのかも分かりません。
次はどのフォルダの勉強をするのがよいのかご教示頂けませんでしょうか。

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

[12967]簡単なマクロを書いてみる – 基本編

2021-04-14 10:18:46 受講生さんからの投稿です。

操作のコツも合わせて教えいただき、ありがとうございました。

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

[12966]【追加特典】「R」から「D」を作る様子-ショートカットキーを使った場合

2021-04-13 14:22:25 受講生さんからの投稿です。

ショートカットキーの活用で作業がサクサク行けるのがよくわかりました。
ショートカットキーをもっと覚えておきたいです。
ありがとうございました。

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

[12965]エクセル仕事を劇的に簡単にするDPRフレームワークその5

2021-04-13 13:57:42 受講生さんからの投稿です。

DPR順番を意識しての仕事やり易さがよく理解できました。
Rをする前にDからスタートすることを実行していきたいです。
ありがとうございました。

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

[12964]エクセル仕事を劇的に簡単にするDPRフレームワークその1

2021-04-13 13:09:31 受講生さんからの投稿です。

四角に、データが詰まった状態。
一言で覚えられる、素晴らしい教え方。
ありがとうございました。

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

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

2021-04-12 16:36:07 受講生さんからの投稿です。

いつも丁寧な解説で、迷いなく設定できます。
ありがとうございました。

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

[12959]エクセルマクロ・VBAを利用するための推奨設定 – Excel2010、Excel2013、Excel2016の場合

2021-04-12 16:05:26 受講生さんからの投稿です。

とても丁寧に解説されて、分かりやすかったです。
画像がぼやけていたけれど、確認はできます。
ありがとうございました。

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

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

2021-04-12 14:05:34 ゲストさんからの投稿です。

とても分かりやすかった。
これから、このような教え方で勉強していくのが楽しみです。
ありがとうございました。

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

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

2021-04-04 21:49:25 藤村英夫さんからの投稿です。

この動画は本当に汎用性が高く 仕事でも色々なマクロに使用させて頂いております。久々にこの動画を復習の為にスマホで見直したのですが 音声が去年の10月の他の生徒さんの御指摘からまだ修正されていないのでしょうか?電車の中で聴いているせいもあり 聞こえにくく残念です。

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

[12948]データ記入用ファイルを配布する-その2

2021-03-28 18:58:13 ゲストさんからの投稿です。

小川様

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

変数foldernameと変数filenameを用いるところでエラーが出てしまい半日悩んでいましたが、過去のコメントを見直し、演習動画を何度も見直し、演習動画のコードを完璧に再現することによってエラーを解消することができました。

問題に行き詰まった時の乗り越え方が少し分かったような気がしました。

演習動画の内容を完璧に再現することを心がけます。

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

[12946]発展1講座第4章 – Select Case 条件の範囲選択

2021-03-28 15:09:41 受講生さんからの投稿です。

変数のstrEvは何の略でしょうか?

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

[12943]複数シートを作成し、取引先名リストにあるのと同じ名前を順に割り当てる

2021-03-23 21:11:26 受講生さんからの投稿です。

変数名のwFmとwToがなぜその名称を付けたのか考えてもわからなかったです。(wはworksheetのwだとは推測できました。)
名称の意味が理解できる場合と比べると、理解に時間がかかってしまいます。

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

[12928]条件に一致するデータを別シートに転記する

2021-03-10 23:17:20 受講生さんからの投稿です。

動画名の内容に合ってない質問で申し訳ありません。
今まではrange(“a1”).va と書けばvalue がヒントで出ていたんですけど
worksheets(“元データ”).range(”a1″).va と書いてもvalue がヒントが出てきません。

それからこれは元からそうでしたが
マクロを1行書いて上の行にカーソルを移動させたときRange(“a1”).Valueとなり、小文字から大文字に変わるべきところのうち””で挟まれた部分だけ小文字のままです。どうしてなのでしょうか?

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

[12918]基礎講座第4章5 – 「ハナコのステップ」のふりかえり

2021-03-03 18:31:56 受講生さんからの投稿です。

以下のようなマクロをかいてみたのですが、
H3の欄に何も評価が書かれませんでした。
どうしてでしょうか?

Sub sample0()
Dim tokuten
Dim hyouka

tokuten = Range("g3").Value
hyouka = Range("h3").Value

' If Range("g2").Value > 50 Then
' Range("h2").Value = "合格です"
' Else
' Range("h2").Value = "不合格です"

If tokuten > 50 Then
hyouka = "合格です"
Else
hyouka = "不合格です"

End If
End Sub

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

[12914]ワーク「Alt+Tab」

2021-02-28 22:20:32 受講生さんからの投稿です。

質問です。
[Alt] + [Tab] で切り替えるときエクスプローラ画面でファイルウィンドウがフォーカスされないときがあります。Altキーで切り替えようとすると上のメニューだけで動いてファイルウィンドウでの操作ができません。よろしくお願いいたします。

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

[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件  [ 動画を見る] 

[12894]自動記録機能でマクロを作る - Excel2007、2010、2013、2016の場合の手順

2021-02-15 22:59:56 ゲストさんからの投稿です。

お世話になります。マクロ導入編から基礎編に進みながら、同時に導入編も併用して視聴させていただいています。今現在、実務で作業している中で、毎月発生する操作を自動記録機能でマクロを作り、毎月発生する操作を保存して利用したいのですが、どのように保存したらよいのでしょうか?過去の質問の中で、テキストの中に記載とあったのですが、導入編で見つけることが出来なかったのですが、基礎編に記載があるのでしょうか。申し訳ございませんが、教えていただければ幸いです。

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

[12893]VLookUp関数、Index関数、Match関数より便利なマクロ-該当する行が見つからない場合の処理をアレンジ

2021-02-15 18:50:26 ゲストさんからの投稿です。

小川様

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

こちらの動画と次回の動画を理解し、よどみなくコードが書けるにはどの動画を復習すればよいでしょうか?基礎編フォローアップから前回の内容までを復習し直せばよろしいでしょうか?

今回の動画の内容が自分にとって難しかったため、自分の力不足を実感しました。

お手数をおかけしますが、お返事をよろしくお願いいたします。

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

[12892]複数のマクロを連続実行する - Excel2007,2010,2013,2016の場合

2021-02-15 00:49:44 受講生さんからの投稿です。

いつもお世話になっております。
マックブックプロで受講している為、色々勝手が違い戸惑いますね^^;
maを作ろうとしてマクロ記録をしたら、モジュール1が新たに作られず
rennzokuモジュールに入ってしまいます…

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

[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件  [ 動画を見る] 

[12880]タイピングスキルアップ動画2

2021-01-28 15:26:24 受講生さんからの投稿です。

ホ一ムポジションがズレてました
タタ一ンと練習します

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

[12875]「クラス」と「インスタンス」について

2021-01-26 22:57:54 受講生さんからの投稿です。

58歳、新米プログラマーです。
クラスとインスタンスの関係はわかるのですがオブジェクトの概念がどうもよくわかりません。例えばセルというオブジェクトがあり、そのひな形として様々なプロパティを持ったり、動作(メソッド)ができたりするようになっている。初期値も決められている。A1に具体的な実態を伴ったセルを作ったときにそれがインスタンスで固有の列幅や網掛け色などを持っています。ここまではあっているような気がしています。
一方、動画の3分を超えたあたりのコメントに関する先生の説明で使われる「オブジェクト」の意味がどうもしっくりきません。
「…コメントのクラスというのがあって、コメントの発注をした。そうするとEXCELがコメントの◆オブジェクトを作って◆最低限の設定だけしてそのまま納品した…」の◆で挟んだ部分です。ここでいう「オブジェクトを作る」というのは「インスタンスを作る」ことと何が違うのか?について教えてください。よろしくお願いします。

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

[12854]Functionプロシージャ演習中

2021-01-21 12:46:25 マメコトさんからの投稿です。

ファンクションプロシージャを上手に使いこなせれば、以前はグローバル変数として宣言していたものをかなり減らせるのではないかと思いました。
「どのような処理をどの順番で行うか」
を考えることで、その共通的な処理をファンクション化出来ると思いました。

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

[12837]テキストファイルの操作について

2021-01-17 08:20:56 たかちゃんさんからの投稿です。

複数のCSVファイルを自動で読み込ませるマクロを書いてみました。
・csv内には日付データがない為、ファイル名から日付を取得
・csv内の12項目&日付を配列に入れ、一気にシートに書き出し

csvファイルはこのような感じです。
"ABC1230","掃除機",",000"...
EmEditorで確認した所、utf-8(BOM有)

苦労した点
・金額の,が区切り文字と判断される
→replaceColonという関数を作成し、区切りのカンマのみ
":"(コロン)に置き換えた
・データを配列に入れ、エクセルに書き出すと文字化け
→FileSystemObjectの代わりに、ADODB.streamを使用して
CSVを読ませた
・CSV内の改行が認識されなかった
→ADODB.streamのLineSeparatorの値をデフォルトから変更

ほぼ丸一日かかって書き上げ、動いた時は非常に嬉しかった為
記念投稿します。
とても長いのでコメントは気になさらないで下さい(^^)

今度は、データを使用しどのように分析する為のグラフを作ろう・・
と考えてます。ここはVBAと関係ありませんが、。
マクロは奥が深いです。

【参考URL】
https://tonari-it.com/vba-csv-camma/
https://tonari-it.com/vba-csv-utf8/

'Microsoft Scripting Runtimeにチェックを入れる→FileSystemObjectを使用する為
'Microsoft ActiveX Data Objects x.x にチェックを入れる→ADODB.Streamを使用する為
Public Sub CSVファイルをdataシートへ全て書き出し()
    Dim fs As New Scripting.FileSystemObject
    Dim files As Scripting.files
    Dim file As Scripting.file
    Dim strLine As String
    Dim sData As String
    Dim SPcsvData As Variant
    Dim path As String
    Dim fName As String
    Dim cnt As Long
    Dim ar() As Variant
    Dim c As Long
    'utf-8(BOM有) csvファイルの文字化け対策用
    Dim ado_stream As New ADODB.Stream
    
    'CSVファイルは、BusinessReportフォルダの中へ保存しておく
    path = ThisWorkbook.path & "\BusinessReport"
    Set files = fs.GetFolder(path).files
    
    
    cnt = 0 '配列で使用するカウント用
    For Each file In files
         
        'utf-8 csv文字化け対策
        With ado_stream
            .Charset = "utf-8"
            .LineSeparator = 10 '改行されなかったので設定変更
            .Open
            .LoadFromFile (file)
        
        fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得、この先の配列0に入れる
        
         ado_stream.SkipLine '1行目(タイトル行)は読まない
        'CSVファイルを2行目から1行づつ読み、ar配列へ格納
        Do Until .EOS
            strLine = .ReadText(adReadLine) '一行読む
            sData = replaceColon(strLine) ',000のカンマも区切りと判断される為、区切りのカンマだけ:に置換
            SPcsvData = Split(sData, ":")
            
            ReDim Preserve ar(12, cnt)
            ar(0, cnt) = fName 'ファイル名から取得した日付を配列に格納
            
            'CSVの中の12項目も配列に格納
            For c = LBound(SPcsvData) To UBound(SPcsvData)
                ReDim Preserve ar(12, cnt)
                ar(c + 1, cnt) = Mid(SPcsvData(c), 2, Len(SPcsvData(c)) - 2) 'データが""で囲われているので除去
            Next
                       
            cnt = cnt + 1
        Loop
    
        .Close 'ファイルを閉じる
        End With
        
            
    Next
    
    '何かデータが入っていた時の為に、一度セルのデータを消去
    Worksheets("data").Range("A1").CurrentRegion.ClearContents
    
    '読み込んだCSVファイルのデータを一気に書き出し
    Worksheets("data").Range("A1").Resize(UBound(ar, 2) + 1, UBound(ar, 1) + 1).Value = _
    Application.WorksheetFunction.Transpose(ar) 'Excel関数で行列入替
    
    Set file = Nothing
    Set files = Nothing
    Set fs = Nothing
    
End Sub

Function replaceColon(str As String) As String
    Dim strTemp As String
    Dim quotCount As Long
    Dim L As Long

    For L = 1 To Len(str)
        strTemp = Mid(str, L, 1) '1文字づつ調べる
        If strTemp = """" Then 'ダブルコーテーション(")を単なる記号として扱いたいときは「""」と2つ続けて書く。
            quotCount = quotCount + 1
        ElseIf strTemp = "," Then
            If quotCount Mod 2 = 0 Then
            str = Left(str, L - 1) & ":" & Right(str, Len(str) - L)
            End If
        End If
    Next

    replaceColon = str
End Function
 

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

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

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

小川先生

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

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


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

 

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

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

トップへ