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

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

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

2017-10-19 21:08:25 受講生さんからの投稿です。

nagasa = Len(moji)

For n = 1 To nagasa
If Mid(moji, n, 1) = "、" Then
kazu = kazu + 1

がポイント!
 for の新しい使い方を学んだ!

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

[9075]基礎講座第2章5 - 文字列の結合

2017-10-18 21:43:55 Atakaさんからの投稿です。

小川先生
お返事ありがとうございました。
実践あるのみですねやってみます(>_<)
         

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

[9074]出現回数を数える。CountIf関数がやっていることをマクロで書くと?

2017-10-18 00:35:52 受講生さんからの投稿です。

解説の前半で、goukei=0 ・・・ goukei=goukei+1 とありますが、前半だけの話で完結した場合、最初の「goukei=0」は必要でしょうか?
たとえば、goukei=0 を書かなくても、goukei=0+1 ということになり、結果的には同じことにはなると思いますが。

後半では、goukeiを0にしておかないと一旦クリアにならないので必要だというのは分かりました。

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

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

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

2017-10-17 22:42:19 浦山大さんからの投稿です。

とりあえずどんどん進めています。
今回のお話はとっても参考になりました。
私はもう、口をぽかんと開けて「え…」という状態で10秒位思考停止してました。

改行するマクロは、そのまま実務に使えそうです。
報告書の一部で、ピボットテーブルから持ってきたアンケートのコメントを表にする作業があります。凄い時間かかっていました…。

・個人用マクロブックに少しずつネタを増やしていく
・最適化の視点を持って仕事のファイルを見る

を気にしながら作業していきたいと思います。

7つの習慣みたいですね。
「私は5時間で木を切れと言われたら最初の1時間は斧を研ぐ」
のような文言が第7の習慣にあったような気がします(ちょっと記憶が曖昧です)。

↑使う道具(武器?)を最適な状態にして、
必要な力を軽減させ、全体にかかる時間も減少させるような考え方と認識しました(人間と捉えると運動や精神の修養等で全体のパフォーマンスを上げることと共通のような)。

やっぱり奥が深いですね!
最適化という言葉について、意識させられた1日でした。

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

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

2017-10-16 19:40:02 ゲストさんからの投稿です。

マクロでどんな事が出来るのかのイメージも付いていないのに、なんとなく仕事に役立ちそうという理由で、教室に通おうとしていました。
先にこちらの講座を見つけて良かったです。
私の仕事にどのように活かせるか、考えながら学ぼうと思います。

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

[9065]保険料額表から標準報酬額ごとの保険料負担額を算出する

2017-10-15 16:18:36 受講生さんからの投稿です。

初めて 先にイメージしたことが解説通りになった。
新しいポイントは Exit for
条件を満たした時に For next構文を終了する。

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

[9062]Visual Basic Editorの基本用語と使い方 - プロパティウィンドウ

2017-10-15 12:32:35 受講生さんからの投稿です。

鼻の穴の数というところで笑ってしまいましたが、
とても分かりやすかったです。

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

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

2017-10-15 12:26:57 受講生さんからの投稿です。

業務でマクロの効率性を認識してはいたが、こうやってチャート化されて説明を受けるとなんとしてでも取得しなきゃと思う。勉強頑張ります。

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

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

2017-10-15 11:03:03 浦山大さんからの投稿です。

おはようございます。
ずっと溜まり続けているこのフォローアップ。
今日から取り掛かり始めます!

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

[9052]データ転記先のシートすべてに対し、罫線を引く等の後処理をする

2017-10-13 16:43:27 浦山大さんからの投稿です。

問題文だけ参照にし、
ノーヒントで罫線を引く部分まで作りました(通し番号が振られていない前提で作成)。
きちんと動きました…(大丈夫でしょうか?)。
一度、紙で印刷してみたら、A4用紙3枚分位になりました。

勉強を始めて2か月程でこんなに書けるようになるなんて思っていませんでした。感謝しています。
引き続き、よろしくお願いします(そろそろ、フォローメールセミナー30題にも取り掛かっていきたいと思っています)。

Option Explicit

Dim wFm, wTo, wS, wA As Worksheet
Dim cMx, cCo, cTo As Long
Dim daHiduke As Date
Dim strNamae As String

Sub Zentai()
    Set wFm = Worksheets("main")
    Set wTo = Worksheets("main1")
    cMx = wFm.Range("B" & wFm.Rows.Count).End(xlUp).Row
    cCo = 2
        Delete_Sheet
        Tooshi_bangou
    cCo = 2
        NarabekaeB
    cTo = 16
        Sheet_Create_Kakikomi
    cCo = 2
    strNamae = ""
        NarabekaeA
        Sakujo_Tooshibangou
End Sub

Sub Delete_Sheet()
       For Each wS In Worksheets
       Application.DisplayAlerts = False
           If wS.Name <> "main1" And wS.Name <> "main" Then
                wS.Delete
           End If
       Next
       Application.DisplayAlerts = True
End Sub

Sub Tooshi_bangou()
    For cCo = 2 To cMx
        wFm.Range("A" & cCo).Value = cCo - 1
    Next
End Sub

Sub NarabekaeB()
    With wFm
        wFm.Sort.SortFields.Clear
        wFm.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:G" & cMx)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

Sub Sheet_Create_Kakikomi()
    For cCo = 2 To cMx
        If wFm.Range("B" & cCo).Value <> strNamae Then
            If strNamae <> "" Then
                wA.Range("H2").Value = wA.Range("K" & cTo - 1).Value
                Keisen
            End If
            cTo = 16
            strNamae = wFm.Range("B" & cCo).Value
            wTo.Copy after:=wFm
            Set wA = ActiveSheet
            wA.Name = strNamae
            wA.Range("J12").Value = strNamae
        End If
        With wA.Range("B" & cTo)
            .Offset().Value = Year(wFm.Range("C" & cCo).Value)       'wA B
            .Offset(, 1).Value = Month(wFm.Range("C" & cCo).Value)       'wA C
            .Offset(, 2).Value = Day(wFm.Range("C" & cCo).Value)         'wA D
            .Offset(, 3).Value = wFm.Range("D" & cCo).Value                  'wA E
            .Offset(, 4).Value = wFm.Range("E" & cCo).Value                  'wA F
            .Offset(, 6).Value = wFm.Range("F" & cCo).Value                  'wA G
            Select Case wFm.Range("G" & cCo).Value                                                     'H
                Case Is > 0
                    .Offset(, 7).Value = wFm.Range("G" & cCo).Value              'wA I
                Case Is < 0
                    .Offset(, 8).Value = wFm.Range("G" & cCo).Value              'wA J
            End Select
            If cTo = 16 Then
                .Offset(, 9).Value = .Offset(, 7).Value + .Offset(, 8).Value       'wA K= wA I+ wA J
            Else
                .Offset(, 9).Value = wA.Range("K" & cTo - 1).Value + .Offset(, 7).Value + .Offset(, 8).Value      'wA K=wA Kの一個上+wA I+ wA J
            End If
        End With
        cTo = cTo + 1
    Next
    wA.Range("H2").Value = wA.Range("K" & cTo - 1).Value
    Keisen
End Sub

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

Sub Sakujo_Tooshibangou()
    wFm.Range("A2:A" & cMx).ClearContents
End Sub

Sub Keisen()
    With wA.Range("B16:K" & cTo)
        .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 = xlHairline
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlHairline
        End With
    End With
End Sub

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

[9050]重複しないリストを作成する(並べ替えを行い、最後に元に戻す)

2017-10-13 10:04:46 浦山大さんからの投稿です。

Zentaiというプロシージャに処理をまとめました。
確認の意味で一度見て頂けると嬉しいです。
部分部分は問題ないと思います(ちゃんと動きました)。

・インデントの位置は大丈夫でしょうか?
・一つひとつ細切れにしてチェックしながら取り組めました。
 →いつも先生の仰っているパーツごとに細かく…の意味がとてもよ  くわかりました。実務でも使えそうです。
・早速、実務で作成した長いマクロも整理していきたいと思います。

Option Explicit

Dim ws As Worksheet
Dim cCo, cMx, cMigi As Long 'よくコメントで纏めてあるのを見かけるのでやってみました、問題なく動く
Dim namae As String     '別解、理解できました、使えてます。

Sub Zentai()
    Set ws = Worksheets("main")     '見本と"main"2枚なので明示
    cMx = Range("B" & ws.Rows.Count).End(xlUp).Row
    cCo = 2
    cMigi = 2
        Tooshibanngou   '通番を振る
    cCo = 2     'プロシージャ内で設定し直す方がスマートなんですか?
        Narabekae_B     'B列で並べ替える
        Create_List         'リストを作成する
    cCo = 2     'プロシージャ内で設定し直す方がスマートなんですか?
        Narabekae_A     'A列で並べ替える(並び順を元に戻す)
        Sakujo_Tooshibangou '通番を削除する、これで元通り
End Sub

Sub Tooshibanngou()
    For cCo = 2 To cMx
        ws.Range("A" & cCo).Value = cCo - 1
    Next
End Sub

Sub Narabekae_B()
    With ws
    .Sort.SortFields.Clear
    .Sort.SortFields.Add _
        Key:=Range("B1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:B" & cMx)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

Sub Create_List()
    For cCo = 2 To cMx
        If ws.Range("B" & cCo) <> namae Then
            namae = ws.Range("B" & cCo).Value
            ws.Range("D" & cMigi).Value = cMigi - 1
            ws.Range("E" & cMigi).Value = namae
            cMigi = cMigi + 1
        End If
    Next
End Sub

Sub Narabekae_A()
    With ws
    .Sort.SortFields.Clear
    .Sort.SortFields.Add _
        Key:=Range("A1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:B" & cMx)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

Sub Sakujo_Tooshibangou()
    ws.Range("A2:A" & cMx).ClearContents
End Sub

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

[9048]条件に一致するデータだけのリストを、条件に一致しないデータを削除する方法で同一ファイル内に連続的に作成する。

2017-10-12 22:44:12 受講生さんからの投稿です。

お世話になっております。
[8959]で説明されているDo Loopで上から処理をするとなると、こんな感じになるのでしょうか。違和感があるため、動画のとおりに素直に下からFor Nextで処理したいです。

Sub Sample()
    Dim i As Long, j As Long, wsName As String
    With Sheets("リスト")
        For i = 4 To 7
            Sheets("本番").Copy After:=Sheets(Sheets.Count)
            wsName = .Cells(i, 4)
            ActiveSheet.Name = wsName
            j = 4
            Do While Cells(j, 2).Value <> ""
                If .Cells(i, 3).Value <> Cells(j, 4).Value Then
                    Range(Cells(j, 2), Cells(j, 5)).Delete Shift:=xlUp
                    j = j - 1
                End If
                j = j + 1
            Loop
        Next i
    End With
End Sub

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

[9047]既存レコード内容の削除とデータリンクファイルによる接続について

2017-10-12 09:46:56 受講生さんからの投稿です。

◎「.udl をメモ帳で開いて Data Source= ... 以降の部分を実際に adosample.mdb がある場所に書き換えてもつながらない」ということですね。
→【回答】ご教示いただいた通り、書き換えてみたところ、動作しました。ありがとうございます。.udlソースを直接修正すれば、動作することを確認しました。

◎db参照先は、現在どのような方法で指定していて、変更はどのような手順で行っていますでしょうか。
→【回答】実は、これからやってみようという段階です。udlソースの内容を使えば、出来る事が分かったため、本件解決です。
Excel経由で、Accessを複数人で共有するのは、あまり良くないでしょうか?

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

[9046]1枚のシート内で12ヶ月を横に並べたカレンダーを作成する

2017-10-12 09:29:50 浦山大さんからの投稿です。

おはようございます。
コードの添削、ありがとうございました!
曖昧な部分がクリアになりました。
こういう微妙な部分は、勉強会等に参加させて頂いて、
「いつもひっかかるんですけどどういうことですか?」
「…そんなことか!」
って一つ一つ潰していけると更に伸びそうだなって感じました。
11月or12月に参加したいと考えています。
それまでに発展編1については一通りこなしておきたいと思います!

Option Explicit

Sub Yokonarabe()

Worksheets("Sheet1").UsedRange.Interior.ColorIndex = xlNone '[*1]
Worksheets("Sheet1").UsedRange.ClearContents                '[*2]    '↓一枚のシートでの話なので、これ不要では?

'ワークシート変数 1枚のシートでも、宣言して明示したほうがいいのかな?ってあいまいでした。
'インデント不正部分は、変数の値を設定する際、
'毎回「1インデント前」にずらしていました(手前側のほうがええのかな?とかそんないい加減なレベルでした)。
'ハナコのステップで作業してたら間違わないような気がします…。

Dim daHiduke As Date
Dim cMigi As Long
Dim loTitle As Long
Dim loYoko As Long
    daHiduke = #1/1/2015#
    cMigi = 2
    loTitle = -6
    loYoko = -4
    Do While Year(daHiduke) = 2015
        If Day(daHiduke) = 1 Then '↓インデント不正→一つ奥にずらしました
            loTitle = loTitle + 5
            loYoko = loYoko + 5
            cMigi = 2
            With Range("A1")
                .Offset(, loTitle + 1).Value = "Date"
                .Offset(, loTitle + 2).Value = "weekday"
                .Offset(, loTitle + 3).Value = "memo"
                .Offset(, loTitle + 4).Value = "comment"
                .Offset(, loTitle + 2).ColumnWidth = 10.89
                .Offset(, loTitle + 3).ColumnWidth = 30
                .Offset(, loTitle + 4).ColumnWidth = 20
            End With
        End If
        Range("A" & cMigi).Offset(, loYoko - 1).Value = daHiduke
        Range("B" & cMigi).Offset(, loYoko - 1).Value = WeekdayName(Weekday(daHiduke), True)
        Select Case Range("B" & cMigi).Offset(, loYoko - 1).Value
            Case Is = "土"
                Range("A" & cMigi & ":D" & cMigi).Offset(, loYoko - 1).Interior.Color = vbBlue
            Case Is = "日"
                Range("A" & cMigi & ":D" & cMigi).Offset(, loYoko - 1).Interior.Color = vbRed
        End Select '↓インデント不正→一つ奥にずらしました
        daHiduke = DateAdd("d", 1, daHiduke)
        cMigi = cMigi + 1
    Loop
End Sub

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

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

2017-10-11 22:02:55 受講生さんからの投稿です。

これまでの複合技!
・for next 構文で気をつけることは、データのはじめと終わりに
 自分の求める処理がされているか。
・失敗しながら何度もやってみる。
 成功者ほどたくさん失敗している!byドラッカー

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

[9033]1枚のシート内で12ヶ月を横に並べたカレンダーを作成する

2017-10-11 16:38:06 浦山大さんからの投稿です。

小川先生

お世話になります。
自分で作成してみました。
なんとか、形に出来ました。
しかし、先生のコードと比べると、
・私のは行列指定の変数が3つある→2つに出来る
・もっとすっきりさせられる(offsetの使い方、With文の使い方)
はまだまだだなあ、と感じました。
2週間前は手も足も出なかったので、
やりきれたことは喜ばしかったです。
引き続き、よろしくお願いします!

Sub Yokonarabe()

    ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
    ActiveSheet.UsedRange.ClearContents

    Dim ws As Worksheet
    Dim daHiduke As Date
    Dim cMigi As Long
    Dim loTitle As Long
    Dim loYoko As Long
    Set ws = Worksheets("Sheet1")
    daHiduke = #1/1/2015#
    cMigi = 2
    loTitle = -6
    loYoko = -4
    Do While Year(daHiduke) = 2015
        If Day(daHiduke) = 1 Then
        loTitle = loTitle + 5
        loYoko = loYoko + 5
        cMigi = 2
            With ws.Range("A1")
                .Offset(, loTitle + 1).Value = "Date"
                .Offset(, loTitle + 2).Value = "weekday"
                .Offset(, loTitle + 3).Value = "memo"
                .Offset(, loTitle + 4).Value = "comment"
                .Offset(, loTitle + 2).ColumnWidth = 10.89
                .Offset(, loTitle + 3).ColumnWidth = 30
                .Offset(, loTitle + 4).ColumnWidth = 20
            End With
        End If
        ws.Range("A" & cMigi).Offset(, loYoko - 1).Value = daHiduke
        ws.Range("B" & cMigi).Offset(, loYoko - 1).Value = WeekdayName(Weekday(daHiduke), True)
        Select Case ws.Range("B" & cMigi).Offset(, loYoko - 1).Value
            Case Is = "土"
                ws.Range("A" & cMigi & ":D" & cMigi).Offset(, loYoko - 1).Interior.Color = vbBlue
            Case Is = "日"
                ws.Range("A" & cMigi & ":D" & cMigi).Offset(, loYoko - 1).Interior.Color = vbRed
        End Select
    daHiduke = DateAdd("d", 1, daHiduke)
    cMigi = cMigi + 1
    Loop
End Sub

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

[9031]既存レコード内容の削除とデータリンクファイルによる接続について

2017-10-11 10:13:52 受講生さんからの投稿です。

①UDLファイルを、マニュアルどおりに作成しようとしましたが、
Microsoft Jet 4.0 OLE DB Providerが見当たりません。(Office2016です)
その後のデータベース接続方法も含め、ご教示ください。

②UDLがあると、複数のエクセルから一つのAccessを参照している場合、
Accessの格納先が変わっても、UDL一か所修正すればよいから、便利という認識で相違ないでしょうか?

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

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

2017-10-10 13:40:18 受講生さんからの投稿です。

小川先生、いつもお世話になっております。

【動画9】のフィードバック(コメント:9020)を踏まえ、
追加要件も実装しました。
印刷範囲をクリアするコード(.PrintArea = "")が必要だと
わかるまで時間がかかりました(汗)
添削の程、よろしくお願い致します。

Option Explicit
Dim wOg As Worksheet    '原本シート(main)の変数
Dim wDa As Worksheet    'データシート(main1)の変数
Dim cDaMxRow As Long    'データシート(main1)の最終行を示す変数
Dim cMkRow As Long      '新規シートの行を指定する変数
Dim Skey As String      'データシートの並び替えを指定する変数
    
Public Sub Homework()
    Set wOg = Worksheets("main1")
    Set wDa = Worksheets("main")
    cDaMxRow = wDa.Range("B" & Rows.Count).End(xlUp).Row
    
    DelDenpyou
    BangouFuri
    
    Skey = "B1"
    Narabikae

    CreateDenpyou

    Skey = "A1"
    Narabikae

    DeleteBangou
End Sub

Public Sub DelDenpyou()
    Dim Wsh As Worksheet
    Application.DisplayAlerts = False
    For Each Wsh In Worksheets
        With Wsh
            If .Name <> "main" And .Name <> "main1" Then  '←if文に変更
                .delete
            End If
        End With
    Next Wsh
    Application.DisplayAlerts = True
    PrintSet '[★]追加要件
End Sub

Sub PrintSet() '[★]追加要件
    If wOg.Name = "main" Then
        With wOg.PageSetup
            .LeftHeader = "&A"
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = "[作成日]&D"
        End With
    Else
        With ActiveSheet.PageSetup
            .PrintArea = ""
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
    End If
End Sub

Public Sub BangouFuri()
    Dim cNt As Long
    With wDa.Range("A1")
        .Offset(0, 0).Value = "No."
        For cNt = 1 To 3
            .Offset(cNt, 0).Value = cNt
        Next cNt
    End With
    wDa.Range("A2:A4").AutoFill Destination:=wDa.Range("A2:A" & cDaMxRow)
End Sub

Public Sub CreateDenpyou()
    Dim wMk As Worksheet
    Dim cDaRow As Long
    Dim sClnt As String
    Dim dTda As Date
    For cDaRow = 2 To cDaMxRow
        If sClnt <> wDa.Range("B" & cDaRow).Value Then
            If cDaRow > 2 Then
                Keisen
                PrintSet '[★]追加要件
            End If
            wOg.Copy after:=Worksheets(Worksheets.Count)
            sClnt = wDa.Range("B" & cDaRow).Value
            Set wMk = ActiveSheet
            wMk.Name = sClnt
            cMkRow = 16
        End If
        dTda = wDa.Range("C" & cMkRow).Value
        With wMk
            .Range("B" & cMkRow).Value = Mid(Year(dTda), 3)
            .Range("C" & cMkRow).Value = Month(dTda)
            .Range("D" & cMkRow).Value = Day(dTda)
            .Range("E" & cMkRow).Value = wDa.Range("D" & cMkRow).Value
            .Range("F" & cMkRow).Value = wDa.Range("E" & cMkRow).Value
            .Range("H" & cMkRow).Value = wDa.Range("F" & cMkRow).Value
            If wDa.Range("G" & cMkRow).Value > 0 Then
                .Range("I" & cMkRow).Value = wDa.Range("G" & cMkRow).Value
            Else
                .Range("J" & cMkRow).Value = wDa.Range("G" & cMkRow).Value
            End If
            .Range("K" & cMkRow).Value = WorksheetFunction.Sum(.Range("I16:J" & cMkRow))
        End With
        cMkRow = cMkRow + 1
    Next cDaRow
    Keisen
End Sub

Public Sub Keisen()
    With Range("B16:K" & cMkRow)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
    End With
End Sub

Public Sub Narabikae()
    With wDa
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=wDa.Range(Skey), Order:=xlAscending
            End With
            .SetRange wDa.Range("A1:G" & cDaMxRow)
            .Header = xlYes
            .Apply
        End With
    End With
End Sub

Public Sub DeleteBangou()
    With wDa
        .Activate '←ここに記載し、1回のみの処理に変更
        .Range("A1").Activate
        .Range("A1").EntireColumn.ClearContents
    End With
End Sub

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

[9027]基礎講座第2章5 - 文字列の結合

2017-10-09 22:55:28 Atakaさんからの投稿です。

はじめまして。小川先生。
エクセルを触りだしてまだ半年。仕事で関数式を組み合わせてデータ作成をしています。こちらの講座で勉強して仕事のスピードを上げたいと思っています。
演算子の特徴はマクロだけのルールではなく、エクセルのセル自体のルールと思ってよろしいでしょうか。仕事でデータ作成をしている中で文字列、&、” ”、が多く出てくるので混同してしまいそうなので質問です。

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

[9024]基礎講座第2章6 - セルやシートの指定に使われる文字列

2017-10-09 04:09:45 ゲストさんからの投稿です。

ご丁寧なご返事ありがとうございます。
繰り返しと感じたのは
[a]講座第2章6で述べている
[b]講座第1章12で述べている
[c]講座第1章12で述べている

繰り返しが大切なのはわかります。
でもそれを「講師」が繰り返すのが大切なのでしょうか?
講師が講習生に「繰り返させる」ことが大切なのではないですか?
何故こんなこといちいち言うかというと、
視聴中「あっ、この内容また言ってる」と感じた時に脳が(パソコンでいう)スリープ状態になり、
新情報がその後入ってきても聞き逃してしまう恐れがあるからです。
せっかく動画という媒体を使って学ぶ講義なので、
「この内容は講座第○章○で説明しているから省くけど、分からなかったら見返してね」ぐらいではいけないのでしょうか。
むしろ「講座第○章○」のように(必要に応じて)見直す地点を繰り返してもらう方がよっぽど講義の集中力の維持に役立ちます。

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

[9019]エクセルマクロ・VBAを利用するための推奨設定 - Excel2007の場合

2017-10-08 19:33:55 受講生さんからの投稿です。

普段使っているExcelのバージョンでの説明がされていたので分かりやすかったです。

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

[9018]エクセルマクロ・VBAを利用するための推奨設定 - イントロダクション

2017-10-08 19:14:41 受講生さんからの投稿です。

なんとなく設定していましたが、これを機会に設定を見直したいと思います。

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

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

2017-10-08 18:40:26 受講生さんからの投稿です。

最近会社での部署が変わりExcelのマクロを使う必要が発生しております。
書籍を購入して独学しておりましたが、独学だとなかなか捗らないので悩んでいたところ本サイトを見つけました。早く業務に役立てるように勉強させて頂きたいと思っております。

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

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

2017-10-08 09:38:21 受講生さんからの投稿です。

小川先生、いつもお世話になっております。

宿題を投稿します。
罫線に関しては、自動記録のコードを基にネットの情報も参考にテストを繰り返して
不要と思われるコードを削除して仕上げました。
他の方の投稿と先生のコメント、勉強になります。

添削の程、よろしくお願い致します。

Option Explicit
    Dim WOg As Worksheet    '原本シート(main)の変数
    Dim WDa As Worksheet    'データシート(main1)の変数
    Dim WMk As Worksheet    '新規シートの変数
    Dim Ws As Worksheet     '全てのシートを示す変数
    Dim CDaRow As Long      '原本シート(main)の行を示す変数
    Dim CDaMxRow As Long    '原本シート(main)の最終行を示す変数
    Dim CMkRow As Long      '新規シートの行を指定する変数
    Dim SKey As String      'データシートの並び替えを指定する変数
    Dim St As String        'データシートの取引記録に登場する取引先を示す変数
    Dim Dtda As Date        'データシートの日付を示す変数
    
Public Sub Homework()
    Set WOg = Worksheets("main1")
    Set WDa = Worksheets("main")
    CDaMxRow = WDa.Range("B" & Rows.Count).End(xlUp).Row
    
    DeleteDenpyou
    BangouFuri
    
    SKey = "B1"
    Narabikae
    
    CreateDenpyou
    
    SKey = "A1"
    Narabikae
    
    DeleteBangou
End Sub

Private Sub DeleteDenpyou()
    Application.DisplayAlerts = False
    For Each Ws In Worksheets
        Select Case Left(Ws.Name, 4)
            Case "main"
            Case Else
                Ws.delete
        End Select
    Next Ws
    Application.DisplayAlerts = True
End Sub

Private Sub BangouFuri()
    With WDa
        With .Range("A1")
            .Offset(0, 0).Value = "No."
            .Offset(1, 0).Value = .Offset(1, 0).Row
            .Offset(2, 0).Value = .Offset(2, 0).Row
            .Offset(3, 0).Value = .Offset(3, 0).Row
        End With
        .Range("A2:A4").AutoFill Destination:=WDa.Range("A2:A" & CDaMxRow)
    End With
End Sub

Private Sub CreateDenpyou()
    '▼新規シート作成
    CMkRow = 16
    For CDaRow = 2 To CDaMxRow
        If St <> WDa.Range("B" & CDaRow).Value Then
            If CDaRow > 2 Then
                Keisen
            End If
            WOg.Copy after:=Worksheets(Worksheets.Count)
            Set WMk = ActiveSheet
            St = WDa.Range("B" & CDaRow).Value
            WMk.Name = St
            CMkRow = 16
        End If
        Dtda = WDa.Range("C" & CDaRow).Value
        '▼データ転記
        With WMk
            '[1]
            .Range("B" & CMkRow).Value = Format(Dtda, "yy")
            .Range("C" & CMkRow).Value = Format(Dtda, "mm")
            .Range("D" & CMkRow).Value = Format(Dtda, "dd")
            '[2]
            .Range("E" & CMkRow).Value = WDa.Range("D" & CDaRow).Value
            .Range("F" & CMkRow).Value = WDa.Range("F" & CDaRow).Value
            .Range("H" & CMkRow).Value = WDa.Range("F" & CDaRow).Value
            '[3]
            If WDa.Range("G" & CDaRow).Value > 0 Then
                .Range("I" & CMkRow).Value = WDa.Range("G" & CDaRow).Value
            Else
                .Range("J" & CMkRow).Value = WDa.Range("G" & CDaRow).Value
            End If
            '[4]
            If CMkRow = 16 Then
                .Range("K" & CMkRow).Value = _
                    WorksheetFunction.Sum(.Range("I16:J16"))
            Else
                .Range("K" & CMkRow).Value = _
                    .Range("K" & CMkRow - 1).Value + _
                    WorksheetFunction.Sum(.Range("I" & CMkRow & ":J" & CMkRow))
            End If
        End With
        CMkRow = CMkRow + 1
    Next CDaRow
    Keisen
    WDa.Activate
End Sub

Private Sub Keisen()
    With WMk.Range("B16:K" & CMkRow)
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
    End With
End Sub

Private Sub Narabikae()
    With WDa.Sort.SortFields
        .Clear
        .Add Key:=WDa.Range(SKey), Order:=xlAscending
    End With
    With WDa.Sort
        .SetRange WDa.Range("A1").CurrentRegion
        .Header = xlYes
        .Apply
    End With
    WDa.Activate
    WDa.Range("A1").Activate
End Sub

Private Sub DeleteBangou()
    WDa.Range("A1").EntireColumn.ClearContents
End Sub

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

[9012]フォローアップミニセミナーNo.04

2017-10-07 23:12:49 浦山大さんからの投稿です。

2回目です。
1回目の時にコメント欄でForEach構文で作成されたコードがあったため、挑戦してみました。offsetも閃くことが出来ました。
HidaとMigiは鉄板ですね。
rgHidaがくどいかな?最初with文入れてみたんですが、行数増えちゃうので消しました。もう少し長大なときは使いたいと思いました。

Sub renshu()
    Dim rgHida As Range
    Dim rgMigi As Range
    For Each rgMigi In Range("E4:E15")
        For Each rgHida In Range("A4:A29")
            If rgHida.Value = rgMigi.Value Then
                rgHida.Font.Bold = True
                rgHida.Offset(, 2).Value = rgMigi.Offset(, 1).Value
                Exit For
            End If
        Next
    Next
End Sub

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

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

2017-10-06 19:01:04 受講生さんからの投稿です。

・上の行と下の行の値を比べることで番号を割り振ることができる。

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

[9004]フォローアップミニセミナーNo.12

2017-10-06 16:16:53 浦山大さんからの投稿です。

・Is○○関数、一通りヘルプで確認しました。
・1文字ずつ調べる、というのが久しぶりで思いつきませんでした。

まだまだ向上の余地はたくさんありますね。
道具をたくさん頂いているので、きちんと頭に入っていれば、
もう大抵のことは出来るんじゃないかなあ、と感じました。
使えないのは練習してないだけ、ですね。
精進します。

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

[9003]フォローアップミニセミナーNo.11

2017-10-06 14:06:41 浦山大さんからの投稿です。

折角なので、テキストを見返して色々練習してみました。
ここに何か書くって思うと、色々試そうと思えます。

Sub renshu()
    Worksheets("Sheet3").Range("B2").Value = UCase(Worksheets("Sheet3").Range("A2").Value)  'AE-055
    Worksheets("Sheet3").Range("B3").Value = Trim(Worksheets("Sheet3").Range("A3").Value)   'AE-055(左右のスペースなくなる)
    Worksheets("Sheet3").Range("B4").Value = LTrim(Worksheets("Sheet3").Range("A3").Value)  'AE-055  (先頭文字以前のスペースがなくなる)
    Worksheets("Sheet3").Range("B5").Value = RTrim(Worksheets("Sheet3").Range("A3").Value)  '  AE-055(最後の文字以後のスペースがなくなる)
    Worksheets("Sheet3").Range("B6").Value = Trim(UCase(Worksheets("Sheet3").Range("A4").Value))    'AE-055(左右スペースなくなる、且つ小文字を大文字にする)
    Worksheets("Sheet3").Range("B7").Value = StrConv(Worksheets("Sheet3").Range("A4").Value, vbUpperCase)   'AE-055(小文字を大文字にする)
    Worksheets("Sheet3").Range("B8").Value = StrConv(Worksheets("Sheet3").Range("A4").Value, vbProperCase)  'Ae-055(先頭だけ小文字を大文字にする)
    Worksheets("Sheet3").Range("B9").Value = Trim(StrConv(Worksheets("Sheet3").Range("A4").Value, vbProperCase + vbWide))   ' Ae-055(左右のスペース削除、先頭だけ小文字→大文字、半角→全角にする)
End Sub


Ucase=Upper
Lcase=Lower
LTrim=Left
RTrim=Right
StrCovr=StringConvert

って意味なんですかね?
知ってる言葉と意味づけして憶えました!
多分これで大丈夫かと思っています。
それにしてもテキストは奥深いです。
コード書くのと同じくらい、新しいことを学び、整理する癖もつけていきたいと思います。

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

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

2017-10-06 13:44:30 受講生さんからの投稿です。

マクロを使うと何ができるのだろう?と興味本位で視聴しましたが、
パラパラと請求書が出来ていく様子を見て衝撃を受けました。

どれくらい難易度が分かりませんが、
そのようなことが自分もできるようになれば、かなりの時間節約になりそうです・・!ぜひ習得したいと思いました。

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

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

2017-10-03 13:05:00 受講生さんからの投稿です。

「value」の入力補完をする技に、上級者の作業効率を高める為のコツを垣間見た思いがしました。

一つ一つの解説が、本当にマクロど素人の私にも解りやすく話されているので、有難いです。

まだ基礎の「き」でしょうけど、マクロなんてとんでもないという思いも、小川先生に付いていったら、もしかしたら自分でもマスターできるかも!
そんな気持ちにさせられています(^-^;

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


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

 

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

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

トップへ