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

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

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

2019-03-18 20:51:59 赤澤 勇二さんからの投稿です。

フォローメールメ-ルセミナー第30回ですね。
メールプリントアウトで一冊のファイルが完成しました。
EmEditor大活躍でした。
仕事柄3交代の勤務でメール見るのも朝、夕、真夜中でメールのプリントアウトのみの日も多くありました。
内容は把握出来るので時間をかけて復習します。

追記
復習ついでにカレンダーを改良して日程管理表と日程シミュレーションを作ります。

会社に縛られず でも 楽しく会社に貢献出来るマクロを作成します。 「自分が楽をする為に」

頑張ろう! 日本のモノ作り!!

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

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

2019-03-08 09:55:42 受講生さんからの投稿です。

色見本ですね 結構会社で使います、何回もマクロ作りました。
機械加工の時に穴あけのサイズとか種類、角度等々、表作成の識別に重宝しています。
保管庫、覚えましたので今度からは取り出すだけにします。

次回も楽しみにしています。

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

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

2019-03-08 09:53:59 受講生さんからの投稿です。

色見本ですね 結構会社で使います、何回もマクロ作りました。
機械加工の時に穴あけのサイズとか種類、角度等々、表作成の識別に重宝しています。
保管庫、覚えましたので今度からは取り出すだけにします。

次回も楽しみにしています。

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

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

2019-03-06 11:16:10 受講生さんからの投稿です。

小川先生 Selctyon の使い分けでこの様な事が一瞬で出来るマクロを知っただけでも大満足です。

「楽して結果を出したいから!」 

昔N88BASICやDOS_BASICをかなり時間をかけて作りましたが
エクセルのマクロは凄いですね 時間の許す限り覚えたいと思います。

つい最近までCADのマクロを作っていました。

リアルタイムで動くマクロを覚えて、楽しんで爽快に仕事がこなせるのであれば努力は惜しみません。

いちばん楽な書き方 ご指導宜しくお願い致します。

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

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

2019-03-04 07:15:05 受講生さんからの投稿です。


インターネットで検索したのですが表記の方法が変わってるみたいで

Sheet1上のセルA1の文字列
第001回 「巨大台風から日本を守れ 富士山頂・男たちは命をかけた」(富士山レーダ
ー・三菱電機 3月28日)

の部分が 
コピペした内容

001 3月28日 巨大台風から日本を守れ
富士山頂・男たちは命をかけた 富士山レーダー 三菱電機 –

このような状況になりました。
「  」と ( )と 他 抜けてしまいました。

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

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

2019-03-03 23:05:43 受講生さんからの投稿です。

伝票印刷(1ページ全部入る)印刷出来る時と出来ない時があり困っています。
長い伝票は出来ます。
.FitToPagesWide = 390 ←プリンターが毎回10-400の入力を求めて来ます。
エクセル操作では問題無く(1ページ全部入る)印刷が出来ます。

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

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

2019-02-22 09:16:31 受講生さんからの投稿です。

連続データ(シート追加後)はどうなっているのか今まで知りませんでしたが今回の講座で明確に分かりました。
if文でシート名が違っていたら、新しいシートを作り(st 名)シートを開いたまま、16行目からシート名が変わるまで(lnTo = lnTo + 1)連続データを書き加える、st名が変わったら(lnTo = 16)16行目から連続データを書き加えるですね
疑問が二つ有りまして一つ減りました。もう一つの疑問が連続シートの個々の(.xls)ファイル作成です。

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

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

2019-02-20 10:04:45 受講生さんからの投稿です。

ワークシートの変数便利ですね 
「目標 フォローメールセミナーには2回に1回は感想を送る事にする」

Sub Sample()
Dim shTo As Worksheet
Set shTo = ActiveSheet
shTo.Name = st
End Sub


Right(Year(dt), 2) Year関数も覚えます。
紙に書いて持ち歩きます。

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

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

2019-02-18 09:37:22 受講生さんからの投稿です。

こんにちは今回メールセミナーでハマってしまいました。
メールとエクセルデータのみでマクロを作りましたが、shFmのところ無意識に読み飛ばしていました。
InFmMax = Range(“b65536”).End(xlUp).Row

lnFmMx = shFm.Range(“B65536”).End(xlUp).Row


st = Range(“B” & Infm).Value

st = shFm.Range(“B” & lnFm).Value
オンライン講座にアクセスしていれば読み飛ばさなかったと思います。

予習ですが
Sub deletsSheets()
Dim ws As Worksheet
For Each ws In Worksheets
Debug.Print ws.Name

If Left(ws.Name, 4) <> “main” Then
ws.Delete
End If
Next
End Sub
ワークシート削除プログラム少しやってみました。動画が沢山ありどの動画か思い出せない事が有ります50代男性です。
分かり易い解説ありがとうございます。

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

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

2019-02-13 05:06:07 A.Sさんからの投稿です。

小川先生

いつもお世話になっております。
第9回に引き続き、第11回の宿題を提出させていただきます。
お忙しいところ大変恐れ入りますが、添削の程、どうぞよろしくお願い致します。

Sub CreateDenpyo()
    DeleteSheets
    Template_Setup
    Numbering
    Narabekae_Torihikisaki
    Denpyosheet_Set
    Narabekae_No
    NumberingDelete
End Sub

'「main1」シートのページ設定をするマクロ
Private Sub Template_Setup()
    With Sheets("main1").PageSetup
        .PrintArea = "" '印刷範囲の解除
        .CenterHeader = "&A" 'ヘッダーに「シート名」を挿入
        .CenterFooter = "&P" 'フッターに「ページ番号」を挿入
    End With
    Range("A1").Select
End Sub

'「main」シートのA列に番号を振るマクロ
Private Sub Numbering()
    Dim ln As Long
    Dim lnMx As Long
    Dim ws As Worksheet
    Set ws = Worksheets("main")
    ws.Range("A1").Value = "No."
    lnMx = ws.Range("B" & Rows.Count).End(xlUp).Row
    For ln = 2 To lnMx
        ws.Range("A" & ln).Value = ln
    Next
End Sub

'「main」シートのA列のデータを全て削除するマクロ
Private Sub NumberingDelete()
    Dim lnMx As Long
    Dim ws As Worksheet
    Set ws = Worksheets("main")
    lnMx = ws.Range("A" & Rows.Count).End(xlUp).Row
    ws.Range("A1:A" & lnMx).ClearContents
End Sub

'「main」シートのB列を昇順に並び替えるマクロ
Private Sub Narabekae_Torihikisaki()
    With Worksheets("main").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("B2:B317"), _
    SortOn:=xlSortOnValues, _
    Order:=xlAscending, _
    DataOption:=xlSortNormal
    .SetRange Range("A1:G317")
    .Header = xlYes
    .Apply
    End With
End Sub

'「main」シートのA列を昇順に並び替えるマクロ
Private Sub Narabekae_No()
    With Worksheets("main").Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("A2:A317"), _
    SortOn:=xlSortOnValues, _
    Order:=xlAscending, _
    DataOption:=xlSortNormal
    .SetRange Range("A1:G317")
    .Header = xlYes
    .Apply
    End With
End Sub

'取引先毎の伝票シートを作成するマクロ
Private Sub Denpyosheet_Set()
    DeleteSheets
    Dim lnFm As Long
    Dim lnFmMx As Long
    Dim lnTo As Long
    Dim st As String
    Dim wsFm As Worksheet
    Dim wsTo As Worksheet
    Dim dt As Date
    Set wsFm = Worksheets("main")
    lnFmMx = wsFm.Range("B" & Rows.Count).End(xlUp).Row
    For lnFm = 2 To lnFmMx
        If st <> wsFm.Range("B" & lnFm).Value Then
            If lnFm > 2 Then
                Keisen
            End If
            st = wsFm.Range("B" & lnFm).Value
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Set wsTo = ActiveSheet
            wsTo.Name = st
            lnTo = 16
        End If
        wsTo.Range("E" & lnTo).Value = wsFm.Range("D" & lnFm).Value
        wsTo.Range("F" & lnTo).Value = wsFm.Range("E" & lnFm).Value
        wsTo.Range("H" & lnTo).Value = wsFm.Range("F" & lnFm).Value
        If wsFm.Range("G" & lnFm).Value > 0 Then
            wsTo.Range("I" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("J" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        End If
        If lnTo = 16 Then
            wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value
        Else
            wsTo.Range("K" & lnTo).Value = wsFm.Range("G" & lnFm).Value + wsTo.Range("K" & lnTo).Offset(-1).Value
        End If
        dt = wsFm.Range("C" & lnFm).Value
        wsTo.Range("B" & lnTo).Value = Format(dt, "yy")
        wsTo.Range("C" & lnTo).Value = Format(dt, "m")
        wsTo.Range("D" & lnTo).Value = Format(dt, "d")
        lnTo = lnTo + 1
    Next
    Keisen
End Sub

'取引先名称シートを削除するマクロ
Public 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

'取引先名称シートに罫線を作成するマクロ
Private Sub Keisen()
    Dim lnMx As Long
    lnMx = Range("B" & Rows.Count).End(xlUp).Row
    With Range("B16:K" & lnMx + 1)
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlHairline
        End With
    End With
End Sub

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

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

2019-02-11 05:20:39 Takao Kanekoさんからの投稿です。

小川先生、
Module18の下記の課題について質問があります。
[3]で見つけてきた曜日の背景色を調べてくる
[4]で調べた色で、[1]で取得したセル全体を塗りつぶす
土曜日に青色、日曜日に赤色となるはずが、
日曜日に青色、月曜日に赤色と一つズレた実行結果になります。

自分が書いていたマクロに問題があるのかと思いましたが、新しくダウンロードした回答も同じになりました。
実行した年度は、2009年と2019年です。
さらに、「なんでだろう?」と自分で簡単なテストしました。
2019年1月1日(火)なので、Weekday関数の引数は3となるのですが、
なぜかWeekdayname関数だと、水曜日となります。
今朝から、この解けきれない問題のループにハマってしまってます。
どうかお教え頂けますでしょうか?
よろしくお願いします。

Takao

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

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

2019-02-09 17:30:14 Takao Kanekoさんからの投稿です。

小川先生、

1.With EndWithの中の構文は、オブジェクトを指定すれば、こちらが認識されて動くのは新しい発見でした。今までWith構文は、その同じオブジェクトを対象とするものしか入れられないと思ってました。

その動作が見られたのは、Module16 With構文中のさらに、For nextの入れ子の ”rgSummary.Offset(c, cYoko).Formula =”が始まる部分です。

2.
rgSummaryというように、
シートのRangeに変数名を付ける、この変数名がすごくわかりやすいと思いました。
参考にしたいと思います。

3.
>ちなみに、ここまでスラスラとできる人は、すでに達人です。
そうなれるように、引き続きがんばります٩( ‘ω’ )و !

Takao

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

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

2019-02-04 20:32:10 A.Sさんからの投稿です。

小川先生

いつも分かり易い講座をありがとうございます。
発展編1 フォローメールセミナー 第9回で宿題をいただいた伝票作成マクロを作成しましたので送らせていただきます。
自分なりに最初から作成していき、途中で詰まりながらも何とか最後まで辿り着き、動くところまで確認できました。
お忙しいところ大変恐れ入りますが、添削の程、どうぞよろしくお願い致します。

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

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

2019-02-01 03:35:39 Takao Kanekoさんからの投稿です。

小川先生、

早速のご返答ありがとうございます。
Tempの略称だったのですね。
小川先生の変数名は、略称なのにかかわらず、パッと見てすぐ意味が分かるものななので、こういうところも真似したいと思い質問させていただきました。

学習方法の方向性が間違ってないことが判り、安心しました。

そうでした。自力で書けた次は、自分の言葉で人に説明しながら、学ぶスタイルでさらに上を目指して理解を深めたいと思います。

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

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

2019-01-31 20:38:20 Takao Kanekoさんからの投稿です。

小川先生、

少し細かいことで申し訳ないのですが、
Dim dtTp As Dateの”Tp”は何の意味を指しますか?

この第22回のセミナーは、今まで触れることがなかった日付マクロ作成などを学習出来てよかったです。

始めは慣れなかったので、トライ・アンド・エラーを何回も繰り替えして演習問題を解きました。そうすると、ステップインF8でロジックの理解よりも、記憶を頼りにしマクロを書き上げているような気がしました。マクロはちゃんと動きますし、今まで分からないところは、基礎編の演習問題もこうして解いて、後でピーンと来たりします。この学習方法で、何か改善するところがあれば、お教え下さい。大丈夫でしょうか。

どうぞよろしくお願いします。

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

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

2019-01-04 22:09:01 受講生さんからの投稿です。

ありがとうございます。誰かのためにと思って、再度復習をさせていただいております。
こういった内容ご掲示いただきまして、ありがとうございます。

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

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

2018-10-20 13:06:42 受講生さんからの投稿です。

お世話になっております。
内容的に送信先がこちらではない気もしますが、ご対応お願い致します。
第20回のメールセミナーが届いていません。
再送をお願いいたします。

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

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

2018-10-06 06:56:34 わかやまさんからの投稿です。

小川様

インデントの重要度を再認識いたしました。
それと、修正したコードの中身が気になりました。
これはどれぐらい先に扱えるようになるでしょうか?

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

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

2018-10-06 06:40:04 わかやまさんからの投稿です。

小川様 

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

Sub ikkini()
    sort1
    hontai
    sort2
End Sub


Sub sort1()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("B2:B" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal  'ワークシートを指定しました
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
    Worksheets("main").Range("A1").Value = "No."
    Worksheets("main").Range("A2").Value = 1
    Worksheets("main").Range("A2").AutoFill Destination:=Worksheets("main").Range("A2:A" & cSaigo), Type:=xlLinearTrend 'ワークシートを指定しました
    heda 'ヘッダーとフッターの設定
End Sub


Sub sort2()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("A2:A" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'ワークシートを指定しました
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
End Sub


Sub syokyo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        If Left(ws.Name, 4) <> "main" Then 'Left関数を用いました!
            ws.Delete
        End If
        Application.DisplayAlerts = True
    Next
End Sub


Sub hontai()
    syokyo
    Dim cGyo As Long
    Dim cSaigo As Long
    Dim wsMain As Worksheet
    Dim wsNow As Worksheet
    Dim sGyosya As String
    Dim dDate As Date
    Dim cSaki As Long
    Set wsMain = Worksheets("main")
    cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
    For cGyo = 2 To cSaigo
        If sGyosya <> wsMain.Range("B" & cGyo).Value Then
            If cGyo > 2 Then
                keisen2
            End If
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
            Set wsNow = ActiveSheet
            sGyosya = wsNow.Name
            cSaki = 16
        End If
        wsNow.Range("F2").Value = wsNow.Name
        wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
        wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
        wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
        dDate = wsMain.Range("C" & cGyo).Value
        wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
        wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
        wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
        If wsMain.Range("G" & cGyo) > 0 Then
            wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        ElseIf wsMain.Range("G" & cGyo) < 0 Then
            wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        End If
        If cSaki = 16 Then
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
        Else
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
        End If
        cSaki = cSaki + 1
    Next
    keisen2
End Sub


Sub keisen2() 'ネットで調べ、シンプルにしました。同じ動作にはなっております。
    Dim cSaigo As Long
    Dim wsNow As Worksheet
    Set wsNow = ActiveSheet
    cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
    wsNow.Range("B16:K" & cSaigo).Borders.LineStyle = xlContinuous
End Sub


Sub heda()
    With Worksheets("main1").PageSetup
        .CenterHeader = "伝票"
        .CenterFooter = Date
    End With
End Sub

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

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

2018-10-04 04:53:28 わかやまさんからの投稿です。

小川様

再度、手直しいたしました。添削、どうぞよろしくお願いします。

Sub ikkini()
    sort1
    hontai
    sort2
End Sub


Sub sort1()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("B2:B" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal  'ワークシートを指定しました
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
    Worksheets("main").Range("A1").Value = "No."
    Worksheets("main").Range("A2").Value = 1
    Worksheets("main").Range("A2").AutoFill Destination:=Worksheets("main").Range("A2:A" & cSaigo), Type:=xlLinearTrend 'ワークシートを指定しました
End Sub


Sub sort2()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Worksheets("main").Range("A2:A" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'ワークシートを指定しました
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
End Sub


Sub syokyo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        If Left(ws.Name, 4) <> "main" Then 'Left関数を用いました!
            ws.Delete
        End If
        Application.DisplayAlerts = True
    Next
End Sub


Sub hontai()
    syokyo
    Dim cGyo As Long
    Dim cSaigo As Long
    Dim wsMain As Worksheet
    Dim wsNow As Worksheet
    Dim sGyosya As String
    Dim dDate As Date
    Dim cSaki As Long
    Set wsMain = Worksheets("main")
    cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
    For cGyo = 2 To cSaigo
        If sGyosya <> wsMain.Range("B" & cGyo).Value Then
            If cGyo > 2 Then
                keisen2
            End If
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
            Set wsNow = ActiveSheet
            sGyosya = wsNow.Name
            cSaki = 16
        End If
        wsNow.Range("F2").Value = wsNow.Name
        wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
        wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
        wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
        dDate = wsMain.Range("C" & cGyo).Value
        wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
        wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
        wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
        If wsMain.Range("G" & cGyo) > 0 Then
            wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        ElseIf wsMain.Range("G" & cGyo) < 0 Then
            wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        End If
        If cSaki = 16 Then
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
        Else
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
        End If
        cSaki = cSaki + 1
    Next
    keisen2
End Sub


Sub keisen2() 'ネットで調べ、シンプルにしました。同じ動作にはなっております。
    Dim cSaigo As Long
    Dim wsNow As Worksheet
    Set wsNow = ActiveSheet
    cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
    wsNow.Range("B16:K" & cSaigo).Borders.LineStyle = xlContinuous
End Sub

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

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

2018-10-03 05:06:50 受講生さんからの投稿です。

小川様

添削ありがとうございました。リライトいたしました。再度、添削をお願いいたします。

Sub ikkini()
    sort1
    hontai
    sort2
End Sub


Sub sort1()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Range("B2:B" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
    Worksheets("main").Range("A1").Value = "No."
    Worksheets("main").Range("A2").Value = 1
    Worksheets("main").Range("A2").AutoFill Destination:=Range("A2:A" & cSaigo), Type:=xlLinearTrend
End Sub


Sub sort2()
    Dim cSaigo As Long
    cSaigo = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Worksheets("main").Sort.SortFields.Clear
    Worksheets("main").Sort.SortFields.Add Key:=Range("A2:A" & cSaigo), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & cSaigo)
        .Header = xlYes
        .Apply
    End With
End Sub



Sub syokyo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        If ws.Name = "main" Or ws.Name = "main1" Then
        Else
            ws.Delete
        End If
        Application.DisplayAlerts = True
    Next
End Sub


Sub hontai()
    syokyo
    Dim cGyo As Long
    Dim cSaigo As Long
    Dim wsMain As Worksheet
    Dim wsNow As Worksheet
    Dim sGyosya As String
    Dim dDate As Date
    Dim cSaki As Long
    Set wsMain = Worksheets("main")
    cSaigo = wsMain.Range("B" & Rows.Count).End(xlUp).Row
    For cGyo = 2 To cSaigo
        If sGyosya <> wsMain.Range("B" & cGyo).Value Then
            If cGyo > 2 Then
                keisen
            End If
            Sheets("main1").Copy After:=Sheets(Worksheets.Count)
            Sheets("main1 (2)").Name = wsMain.Range("B" & cGyo).Value
            Set wsNow = ActiveSheet
            sGyosya = wsNow.Name
            cSaki = 16
        End If
        wsNow.Range("F2").Value = wsNow.Name
        wsNow.Range("H" & cSaki).Value = wsMain.Range("F" & cGyo).Value
        wsNow.Range("F" & cSaki).Value = wsMain.Range("E" & cGyo).Value
        wsNow.Range("E" & cSaki).Value = wsMain.Range("D" & cGyo).Value
        dDate = wsMain.Range("C" & cGyo).Value
        wsNow.Range("B" & cSaki).Value = Format(dDate, "yy")
        wsNow.Range("C" & cSaki).Value = Format(dDate, "mm")
        wsNow.Range("D" & cSaki).Value = Format(dDate, "dd")
        If wsMain.Range("G" & cGyo) > 0 Then
            wsNow.Range("I" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        ElseIf wsMain.Range("G" & cGyo) < 0 Then
            wsNow.Range("J" & cSaki).Value = wsMain.Range("G" & cGyo).Value
        End If
        If cSaki = 16 Then
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value
        Else
            wsNow.Range("K" & cSaki) = wsMain.Range("G" & cGyo).Value + wsNow.Range("K" & cSaki - 1)
        End If
        cSaki = cSaki + 1
    Next
    keisen
End Sub


Sub keisen()
    Dim cSaigo As Long
    Dim wsNow As Worksheet
    Set wsNow = ActiveSheet
    cSaigo = wsNow.Range("B" & Rows.Count).End(xlUp).Row
    Range("B16:K" & cSaigo).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("B16:K" & cSaigo).Borders(xlDiagonalUp).LineStyle = xlNone
    With Range("B16:K" & cSaigo).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Range("B16:K" & cSaigo).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End Sub

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

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

2018-10-01 06:22:21 わかやまさんからの投稿です。

小川様

いつもありがとうございます。添削をお願いいたします。

Sub ikkini()
    sort1
    hontai
End Sub


Sub sort1()
Dim kazu As Long
Dim saigo As Long
Columns(“A:G”).Select
ActiveWorkbook.Worksheets(“main”).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(“main”).Sort.SortFields.Add Key:=Range(“B2:B317”), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(“main”).Sort
.SetRange Range(“A1:G317”)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

saigo = Worksheets(“main”).Range(“B65536”).End(xlUp).Row
Worksheets(“main”).Range(“A1”).Value = “No.”
For kazu = 2 To saigo
Worksheets(“main”).Range(“A” & kazu).Value = kazu – 1
Next
End Sub[/code]


Sub syokyo()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        If ws.Name = "main" Then
        ElseIf ws.Name = "main1" Then
        Else
            ws.Delete
        End If
        Application.DisplayAlerts = True
    Next
End Sub


Sub hontai()
    syokyo
    Dim gyo As Long
    Dim saigo1 As Long
    Dim wsmain As Worksheet
    Dim wsnow As Worksheet
    Dim gyosya As String
    Dim dt As Date
    Dim saki As Long
    Set wsmain = Worksheets("main")
    saigo1 = wsmain.Range("B65536").End(xlUp).Row
    For gyo = 2 To saigo1
        If gyosya <> wsmain.Range("B" & gyo).Value Then
            If gyo > 2 Then
                keisen
            End If
            Sheets("main1").Copy After:=Sheets(2)
            Sheets("main1 (2)").Name = wsmain.Range("B" & gyo).Value
            Set wsnow = ActiveSheet
            gyosya = wsnow.Name
            saki = 16
        End If
            wsnow.Range("F2").Value = wsnow.Name
            wsnow.Range("H" & saki).Value = wsmain.Range("F" & gyo).Value
            wsnow.Range("F" & saki).Value = wsmain.Range("E" & gyo).Value
            wsnow.Range("E" & saki).Value = wsmain.Range("D" & gyo).Value
            dt = wsmain.Range("C" & gyo).Value
            wsnow.Range("B" & saki).Value = Right(Year(dt), 2)
            wsnow.Range("C" & saki).Value = Month(dt)
            wsnow.Range("D" & saki).Value = Day(dt)
            If wsmain.Range("G" & gyo) > 0 Then
                wsnow.Range("I" & saki).Value = wsmain.Range("G" & gyo).Value
            ElseIf wsmain.Range("G" & gyo) < 0 Then
                wsnow.Range("J" & saki).Value = wsmain.Range("G" & gyo).Value
            End If
            If saki = 16 Then
                wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value
            Else
                wsnow.Range("K" & saki) = wsmain.Range("G" & gyo).Value + wsnow.Range("K" & saki - 1)
            End If
            saki = saki + 1
    Next
    keisen
End Sub


Sub keisen()
    Dim saigo2 As Long
    Dim wsnow1 As Worksheet
    Set wsnow1 = ActiveSheet
    saigo2 = wsnow1.Range("B65536").End(xlUp).Row
    Range("B16:K" & saigo2).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    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
End Sub

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

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

2018-08-30 08:24:57 受講生さんからの投稿です。

いつもお世話になっております。
なんとか作成出来ましたが、まだまだ時間がかかっております。でも、自分でも出来ることがわかったので、大変満足しております。作成したファイルを送らせていただきます。お手数ですが、よろしくお願いいたします。

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

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

2018-08-22 23:20:54 マメコトさんからの投稿です。

「Loopをwithで囲む」というヒントの意味を汲み切れず、問題[4]は未解答のままで今回の解答を拝見しました。
・・・これは秀麗ですね。
range(“A” & c)、range(“B” & c)、という朴訥としたコードより、明らかに洗練されている感じがします。
offsetを「for next構文の横方向バージョン」ぐらいに軽く考えていましたが、withと組み合わせると、こんなにスッキリしたコードになるのですね。
それと、この美しいコードを「読みこなせている」という事実に、率直に自分自身が驚いています。先生のご指導のおかげです。ありがとうございます。

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

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

2018-08-21 21:32:27 マメコトさんからの投稿です。

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

Sub Denpyou()
    Call Sort_First
    Call Delete_Sheets
    Call Create_Denpyou
    Call Sort_End
End Sub

という伝票作成マクロの、Create_Denpyouの中にCreate_Keisenを作り、そのCreate_Keisenの最後に印刷に関するコードを書きました。
・・・とは言え、マクロの記録のどこを削れば良いのかわかりませんでした。
Private Sub Create_Keisen()

    Dim nGyou As Long
    
    nGyou = Range("E" & Rows.Count).End(xlUp).Row
    
    Range("B16:K" & nGyou).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
    
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ":"
        .PrintTitleColumns = ""
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 10
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = True
End Sub

やはりひとつひとつ意味を調べるべきなのでしょうか。

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

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

2018-08-21 16:56:10 マメコトさんからの投稿です。

先生のように30分では書けませんでしたが、1時間はかからずに書けました。(ボタンは作りませんでしたけど。)
「とりあえず動く」ものなので、マクロが記録したコードをそのまま使ったりしています。
いかがでしょうか。

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

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

2018-07-26 00:12:49 のんのんさんからの投稿です。

再提出します。
よろしくお願いします☆

前回の添削で、1か所理解できないところがありました。

「’↓Format関数の活用も検討してください。ogawa」
のところですが、これは rowAnumberingサブプロシージャのどこで Format関数を使えばよいのでしょうか?
よろしくお願いします。

Option Explicit

Dim Retsu As String

Sub CreateDenpyo()
    Application.ScreenUpdating = False
    NumberingA
    Retsu = "B"
    Sorting
    ExeCreateDenpyo
    Retsu = "A"
    Sorting
    Application.ScreenUpdating = True
End Sub

Sub NumberingA() 'シート"main"のA列に順番に番号を付けて行くマクロ
    Dim lngMax As Long  'シート"main"の最大行数を入れる
    Dim lngGyo As Long
    
    lngMax = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    Range("A1").Value = "No."
    For lngGyo = 2 To lngMax
        Range("A" & lngGyo).Value = lngGyo - 1
    Next
End Sub

Sub Sorting()
    Dim lngMax As Long  'シート"main"の最大行数を入れる
    
    lngMax = Worksheets("main").Range("B" & Rows.Count).End(xlUp).Row
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("main").Sort.SortFields.Add _
        Key:=Range(Retsu & "2:" & Retsu & lngMax), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With Worksheets("main").Sort
        .SetRange Range("A1:G" & lngMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub

Sub ExeCreateDenpyo()
    'シート"main"のB列のデータの値によって、
    'シート作成(シート"main1"のコピー)、シート名付与、データ転記するマクロ
    
    Dim lngMax As Long  'シート"main"の最大行数を入れる
    Dim st As String    'シート名(取引先名称)を入れる
    Dim lngFm As Long
    Dim lngTo As Long
    Dim shtFm As Worksheet
    Dim shtTo As Worksheet
    
    DeleteDenpyo
    
    Set shtFm = Worksheets("main")
    shtFm.Activate
    lngMax = shtFm.Range("B" & Rows.Count).End(xlUp).Row
    
    For lngFm = 2 To lngMax
        If st <> shtFm.Range("B" & lngFm).Value Then
            If lngFm > 2 Then
                Keisen
            End If
            st = shtFm.Range("B" & lngFm).Value
            Worksheets("main1").Copy After:=Worksheets(Worksheets.Count)    'コピー
            Set shtTo = ActiveSheet
            shtTo.Name = st 'シート名付与
            lngTo = 16
        End If
        'ここからデータ転記
        shtTo.Range("B" & lngTo).Value = Right(Year(shtFm.Range("C" & lngFm).Value), 2)
        shtTo.Range("C" & lngTo).Value = Month(shtFm.Range("C" & lngFm).Value)
        shtTo.Range("D" & lngTo).Value = Day(shtFm.Range("C" & lngFm).Value)
        shtTo.Range("E" & lngTo).Value = shtFm.Range("D" & lngFm).Value
        shtTo.Range("F" & lngTo).Value = shtFm.Range("E" & lngFm).Value
        shtTo.Range("H" & lngTo).Value = shtFm.Range("F" & lngFm).Value
        If shtFm.Range("G" & lngFm).Value > 0 Then
            shtTo.Range("I" & lngTo).Value = shtFm.Range("G" & lngFm).Value
        Else
            shtTo.Range("J" & lngTo).Value = shtFm.Range("G" & lngFm).Value
        End If
        
        If lngTo = 16 Then
            shtTo.Range("K" & lngTo).Value = shtTo.Range("I" & lngTo).Value + shtTo.Range("J" & lngTo).Value
        Else
            shtTo.Range("K" & lngTo).Value = shtTo.Range("I" & lngTo).Value + shtTo.Range("J" & lngTo).Value + shtTo.Range("K" & lngTo).Offset(-1).Value
        End If
        lngTo = lngTo + 1
    Next
    Keisen
    Worksheets("main").Select
End Sub

Sub DeleteDenpyo()
    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 Keisen()
    Dim lngMax2 As Long
    lngMax2 = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    
    ActiveSheet.Range("B16:K" & lngMax2 + 1).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 = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    Range("A1").Activate
End Sub

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

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

2018-07-15 17:39:18 受講生さんからの投稿です。

Formulaプロパティは、セルの中に式が入っている場合に使うと思えばよいでしょうか?

今回のセミナー内容が自分でも分かったのか、分かってないのかがよく分からず、またどこが分かっていないのかもぼんやりしている状態です。

試しに以下の2つのスクリプトを書いて実行してみました。

Sub formulatest1()
    Dim lnCnt As Long
    For lnCnt = 0 To 10
        MsgBox Range("A4").Offset(, lnCnt).Formula
    Next
End Sub

Sub formulatest2()
    Dim lnCnt As Long
    For lnCnt = 0 To 10
        MsgBox Range("A4").Offset(, lnCnt).Value
    Next
End Sub


ちなみに後の方のValueプロパティを実行すると、A4のところで
実行時エラー13 型が一致しません
と言われてしまいます。

ちなみにA4を削除して実行すると、他のセルでは、エラーは発生せず、
“=IF(K4=””,””,(K4-J4))”という式が入っているセルも空の情報””が入っていると表示されました。・・・これは、式の結果の「値」が情報として表示された、ということか☆きっとそうですね?

それから、
Sub formulatest1を実行すると、日付のところは”2009/6/29″の代わりに”39993″という値が表示されました。これはきっと2009/6/29を表す数字なのだと思うのですが・・・これは、こういうものと覚えておけばきっといいのですよね・・・。

なんか独り言のような書き込みになってしまい、すみません!!

一番知りたかったのは「Formulaプロパティは、セルの中に式が入っている場合に使うと思えばよいでしょうか?」だと思います。
自分でもよく分からない状態なので、質問がはっきりとしてなくて申し訳ないです。
お詫びと共に質問させていただきますm(_ _)m。

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

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

2018-07-14 00:45:47 のんのんさんからの投稿です。

Wikipediaに載っているプロジェクトXの見出しの構成ですが、教材を作られたときから随分と変更があるようです。

この点、説明文に書き加えていただけるとありがたいです。
サンプルファイルのSheet1のような形がどうやったらできるの(泣)??とかなり悩んでしまったので、今後の方のためにもお願いしたいです。
どうぞよろしくお願いいたします。

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

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

2018-07-13 22:31:16 のんのんさんからの投稿です。

こんにちは。
伝票作成のマクロ作ってみました。
添削よろしくお願いします☆

Option Explicit

Dim cmMax As Long
Dim cCnt As Long
Dim wMn As Worksheet
Dim wMn1 As Worksheet
Dim wNs As Worksheet
Dim sRetsu As String
Dim cNcnt As Long
Dim cnMax As Long

Sub CreateDenpyo()
    Call rowAnumbering
    sRetsu = "B"
    Call sorting
    ExeCreateDenpyo
    Worksheets("main").Select
    sRetsu = "A"
    sorting
End Sub

Sub rowAnumbering()
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    wMn.Range("A1").Value = "No."
    For cCnt = 2 To cmMax
        wMn.Range("A" & cCnt).Value = cCnt - 1
    Next
End Sub

Sub sorting()
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    
    wMn.Sort.SortFields.Clear
    wMn.Sort.SortFields.Add Key:=Range(sRetsu & "2:" & sRetsu & cmMax), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With wMn.Sort
        .SetRange Range("A1:G" & cmMax)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub ExeCreateDenpyo()
    Call DeleteSheet
    Set wMn = Worksheets("main")
    cmMax = wMn.Range("B" & Rows.Count).End(xlUp).Row
    Set wMn1 = Worksheets("main1")
    
    For cCnt = 1 To cmMax
        If wMn.Range("B" & cCnt).Value <> wMn.Range("B" & cCnt + 1).Value And wMn.Range("B" & cCnt + 1).Value <> "" Then
            If cCnt <> 1 Then
                Call keisen
            End If
            wMn1.Copy After:=Sheets(2)
            ActiveSheet.Name = wMn.Range("B" & cCnt + 1).Value
            Set wNs = Worksheets(ActiveSheet.Name)
            
            cNcnt = 16
            wNs.Range("B" & cNcnt).Value = Right(Year(wMn.Range("C" & cCnt + 1).Value), 2)
            wNs.Range("C" & cNcnt).Value = Month(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("D" & cNcnt).Value = Day(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("E" & cNcnt).Value = wMn.Range("D" & cCnt + 1).Value
            wNs.Range("F" & cNcnt).Value = wMn.Range("E" & cCnt + 1).Value
            wNs.Range("H" & cNcnt).Value = wMn.Range("F" & cCnt + 1).Value
            If wMn.Range("G" & cCnt + 1).Value > 0 Then
                wNs.Range("I" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            Else
                wNs.Range("J" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            End If
            wNs.Range("K" & cNcnt).Value = wNs.Range("I" & cNcnt).Value + wNs.Range("J" & cNcnt).Value
            cNcnt = cNcnt + 1
        ElseIf wMn.Range("B" & cCnt).Value = wMn.Range("B" & cCnt + 1).Value And wMn.Range("B" & cCnt + 1).Value <> "" Then
            wNs.Range("B" & cNcnt).Value = Right(Year(wMn.Range("C" & cCnt + 1).Value), 2)
            wNs.Range("C" & cNcnt).Value = Month(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("D" & cNcnt).Value = Day(wMn.Range("C" & cCnt + 1).Value)
            wNs.Range("E" & cNcnt).Value = wMn.Range("D" & cCnt + 1).Value
            wNs.Range("F" & cNcnt).Value = wMn.Range("E" & cCnt + 1).Value
            wNs.Range("H" & cNcnt).Value = wMn.Range("F" & cCnt + 1).Value
            If wMn.Range("G" & cCnt + 1).Value > 0 Then
                wNs.Range("I" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            Else
                wNs.Range("J" & cNcnt).Value = wMn.Range("G" & cCnt + 1).Value
            End If
            wNs.Range("K" & cNcnt).Value = wNs.Range("I" & cNcnt).Value + wNs.Range("J" & cNcnt).Value + wNs.Range("K" & cNcnt - 1).Value
            cNcnt = cNcnt + 1
        End If
        If cCnt = cmMax Then
            Call keisen
        End If
    Next
End Sub

Sub DeleteSheet()
    Application.DisplayAlerts = False
    For Each wNs In Worksheets
        If Left(wNs.Name, 4) <> "main" Then
            wNs.Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Sub keisen()
    cnMax = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    Range("B16:K" & cnMax).Borders.LineStyle = xlContinuous
End Sub

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


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

 

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

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

トップへ