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

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

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

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

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

いま仕事でこの機能をつかってデータ加工してます 全部はマクロ化するのは先になりますが部分的でも仕事の効率が違います ありがとうございました

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

[8984]連想配列_3

2017-10-02 23:16:04 受講生さんからの投稿です。

発展編1のファイル"Enshu21200.xls"の伝票作成の問題で、模範解答でなく、連想配列を使って、コードを書いてみました。動きましたが、採点をしていただければ、嬉しいです。

Option Explicit
Sub CreateDenpyo()
    DeleteSheets
    CreateDenpyoExe
End Sub

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

Sub CreateDenpyoExe()
'連想配列を使って、伝票作成のコードを書きました。
    
    Dim dic As New Scripting.Dictionary 'index=取引先名称、Item=転記先シートでの行数とする連想配列。
    Dim c As Long                       'Worksheets("main")の行数カウンター
    Dim cMx As Long                     'Worksheets("main")の最終行数
    Dim dt As Long                      'Worksheets("main")C列の日付
    Dim st As String                    'Worksheets("main")B列の取引先名称
    Dim w As Worksheet                  'Worksheets("main")のニックネーム
    
    Set w = Worksheets("main")
    cMx = w.Range("a65536").End(xlUp).Row
    
    For c = 2 To cMx
        st = w.Range("B" & c).Value
        If dic.Exists(st) = True Then
            dic.Item(st) = dic.Item(st) + 1
        Else
            dic.Add st, 16
            CreateSheets st
        End If
        
        InputData st, c, dic.Item(st)
    Next
    
    Dim vkey As Variant
    vkey = dic.Keys
    For c = LBound(vkey) To UBound(vkey)
        If Left(vkey(c), 4) <> "main" Then
            Keisen vkey(c), dic.Item(vkey(c))
        End If
    Next
    w.Select
    Range("a1").Select
End Sub

Sub CreateSheets(st As String)
    Worksheets("main1").Copy after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = st
End Sub

Sub InputData(st As String, cFm As Long, cTo As Long)
    Dim dt As Date
    Dim wTo As Worksheet
    Dim wFm As Worksheet
    Dim cKingaku
    Set wTo = Worksheets(st)
    Set wFm = Worksheets("main")
    
    dt = wFm.Range("c" & cFm).Value
    wTo.Range("b" & cTo).Value = Right(Year(dt), 2)
    wTo.Range("c" & cTo).Value = Month(dt)
    wTo.Range("d" & cTo).Value = Day(dt)
    wTo.Range("e" & cTo).Value = wFm.Range("d" & cFm).Value
    wTo.Range("f" & cTo).Value = wFm.Range("e" & cFm).Value
    wTo.Range("h" & cTo).Value = wFm.Range("f" & cFm).Value
    
    cKingaku = wFm.Range("g" & cFm).Value
    If cKingaku >= 0 Then
        wTo.Range("i" & cTo).Value = cKingaku
    Else
        wTo.Range("j" & cTo).Value = cKingaku
    End If
    
    If cTo = 16 Then
        wTo.Range("k" & cTo).Value = cKingaku
    Else
        wTo.Range("k" & cTo).Value = wTo.Range("k" & cTo - 1).Value + cKingaku
    End If

End Sub

Sub Keisen(st As Variant, c As Long)
'
' 罫線を引く
    Worksheets(st).Select
    With Range("B16:K" & c + 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

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

[8982]文字列の一部を取り出す(応用例)

2017-10-02 12:38:39 受講生さんからの投稿です。

Instr関数
Left関数
Mid関数の復習になったが、いかに自分が理解していないかがわかった。
何度も見直すこと。

文字列を分割するときに、前のスラッシュと後のスラッシュをInstr関数であらわすが今回のポイント
Instr関数で見つけよう”/”を見つける。

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

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

2017-10-01 18:30:20 受講生さんからの投稿です。

とてもわかりやすい内容でした。

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

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

2017-10-01 17:46:00 横山 知明さんからの投稿です。

発想がすごいです。マスターするのが必死で、質問できるところまでのレベルに
行っていないような気がします。それでも、仕事で使うときに、何も見ないで書けるものも出てきているので、とても嬉しいです。

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

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

2017-10-01 08:08:07 ゲストさんからの投稿です。

この動画で伝えていることは【動画17】 基礎講座第2章5の
繰り返し?
だとしたら、非常にかなしい

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

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

2017-09-29 14:00:51 受講生さんからの投稿です。

一つ一つが丁寧に解説されていたので、設定に苦労せずにスムーズにできました。ありがとうございます。

一応違う点は、
①開発タブが非表示、②拡張子が付いていない所のみ。

ちなみに、私は2010ですが、「Excelブック」→「Excelマクロ有効ブック」という表示。
これは変更した場合何か影響があるか? 気になり調べた所、マクロが保存できるかどうかの違いだけが主のようなので、”枝葉”は無視して、そのまま変更しておきました。

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

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

2017-09-29 12:54:29 受講生さんからの投稿です。

Excel関数の動画解説で理解しやすいものを探していた際、「パソコンスキルの教科書」というサイトから偶然関数<マクロを学ぶ7つのメリットという記事を発見。興味本位で読み、今に至っています。

マクロ=文系人間には難しい!! ⇔ でも、皆がそう思う分、使える人はそれだけで価値を生み、人の役にも立つ。

確かに「魔法」の言葉がピッタリですね。
紹介ページによると、小川先生は経験豊かな教え方のプロで、一番最適な順番、内容も吟味された内容である点が心強く思えましたし、自分を変えるきっかけになる可能性を秘めた存在になるかも。

ちょっと綱引き状態というのが正直な気持ちです。
引き続き、学びを進める事で、自分に合うか、合わないのか。
判断していきたいです。

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

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

2017-09-28 15:53:29 金子 伊智郎さんからの投稿です。

前回と今回の動画を見る前に作ってみました。
ポイントはシートコピーする前に存在したら削除するようにした点です。
下から上に処理をしていくというヒントをもらっていたのでスムーズに
できました。
上から順に処理するとなると行削除する際にカウンターを-1でしょうか..
気持ち悪いコードになりそうです。

Sub mondai3()
    Dim gyo
    Dim jyokyo
    Dim komoku
    Dim sname
    Dim ws As Worksheet
    
    For jyokyo = 4 To 7
        komoku = Worksheets("リスト").Range("C" & jyokyo).Value
        sname = Worksheets("リスト").Range("D" & jyokyo).Value
         
         For Each ws In Worksheets
            If ws.Name = sname Then
                Application.DisplayAlerts = False
                Worksheets(sname).Delete
                Application.DisplayAlerts = True
                Exit For
            End If
         Next
        Sheets("本番").Copy After:=Sheets(7)
        Sheets("本番 (2)").Name = sname
    
        For gyo = 29 To 4 Step -1
            If Worksheets(sname).Range("D" & gyo).Value <> komoku Then
                Worksheets(sname).Rows(gyo & ":" & gyo).Select
                Selection.Delete Shift:=xlUp
            End If
        Next
    Next

End Sub

コメントがないためさびしい限りですが第1号になって見ます。

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

[8945]セル内の文字列から区切り文字を見つけ、その区切り文字の間にある文字列を切り出す

2017-09-27 10:45:42 金子 伊智郎さんからの投稿です。

mae, ato を利用して文字列を切り出すやり方がわかりにくかったので
1文字ずつ連結していく方法で作ってみました。
とりあえず結果は同じになりました。

Sub mondai5()
    Dim mojiretsu
    Dim idx
    Dim yakuwari
    Dim gyo
    Dim hidari
    
    gyo = 2
    For hidari = 2 To 7
        yakuwari = Range("D" & hidari).Value
        For idx = 1 To Len(yakuwari)
            If Mid(yakuwari, idx, 1) = "、" Then
                Range("G" & gyo).Value = Range("B" & hidari).Value
                Range("L" & gyo).Value = mojiretsu
                gyo = gyo + 1
                mojiretsu = ""
            Else
                mojiretsu = mojiretsu & Mid(yakuwari, idx, 1)
            End If
        Next
        Range("G" & gyo).Value = Range("B" & hidari).Value
        Range("L" & gyo).Value = mojiretsu
        gyo = gyo + 1
        mojiretsu = ""
    Next

End Sub

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

[8941]文字列を様々に解析して条件分岐

2017-09-27 05:54:38 受講生さんからの投稿です。

・Instr関数は値が0かどうかで必要な文字列を検索し、その結果に応じた処理ができる。 
Instr関数の復習になった!

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

[8940]「イベントとフォーム」プレセミナー第5回

2017-09-26 23:36:47 受講生さんからの投稿です。

定数、確かに便利ですね、発想が広がりました。

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

[8938]住所情報を都道府県から市区町村レベルで細かく分割する

2017-09-26 13:58:12 受講生さんからの投稿です。

質問ですが、各回のコメントをチェックしていると動画18で一旦基礎編のフォローアップは完結していたのですかね?
動画19以降は後から追加されたもののようですが、動画35までを目標に進めていきます。
本講座をとても気に入っていますので、発展編1も引き続きやりたいところ
ですが経済的な理由もありますので、まずは基礎編を固めたいと思っております。

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


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

 

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

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

トップへ