VBA 商の求め方 まとめ
どうも、こんぺです。
今回、割り算(除算)の「商」の求め方についてメモ程度ですがまとめます。
特にVBA上で日付を取り扱ううえで「商と余り」は頻繁に使う内容で、こちらで紹介したかったのですが、地味にボリュームができてしまい別記事にしました。
日付の扱いについては後日まとめたいと思っています。
割り算(除算)の計算結果取得の手法
VBAでロジックを構成するうえで
- 割り返した時の整数部分を取得した
- 割り返した時の少数部分を取得した
- 余りを取得したい
ということはよくあると思います。
余りは
- mod関数
を利用することが一般的だと思われますが、商を求める方法はいろいろバリエーションがあるようです。
ネットで調べると
- INT関数
- FIX関数
がよくヒットします。が、関数を使わなくても算術演算子「¥マーク(\記号)」で解決しなかったっけ?と思い比較しました。
テストコードと結果
Sub test() Dim num(6) As Double num(0) = 10 / 3 num(1) = Int(10 / 3) num(2) = Int(-10 / 3) num(3) = Fix(10 / 3) num(4) = Fix(-10 / 3) num(5) = 10 \ 3 num(6) = -10 \ 3 Debug.Print num(0) Dim i As Long For i = 1 To 3 Debug.Print num(i * 2 - 1), num(i * 2) Next End Sub
無事、Fix関数と\記号の計算結果が一致。
個人的には\記号で商を求めるのがスマートなのかな…と思っていますが、
Fix関数についてあまり詳しくなくため「\記号がふさわしくない場面」がもしかしたらあるかもしれません。
そのようなパターンがあれば、ぜひ教えて頂きたいですm(_ _)m
VBA 100本ノックNo1~5
お題と回答
#VBA100ノック 1本目
— エクセルの神髄 (@yamaoka_ss) 2020年10月19日
「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
値も数式も書式も全てコピーしてください。
ただしSelectメソッドは使用禁止
※行高と列幅の設定はしなくて良い。
Sub ノック1本目() Sheet1.Range("A1:C5").Copy Sheet2.Range("A1").PasteSpecial End Sub
#VBA100本ノック 2本目
— エクセルの神髄 (@yamaoka_ss) 2020年10月20日
「Sheet1」のA1:C5のセル範囲を、「Sheet2」のA1:C5にコピーしてください。
数式は消して値でコピー、書式もコピーしてください。
※書式は「セルの書式設定」で設定可能なもの(ロックは除く)。
入力規則やメモ(旧コメント)は書式ではありません。
「ふりがな」は任意で
Sub ノック2本目() Sheet1.Range("A1:C5").Copy Sheet2.Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats) End Sub
#VBA100本ノック 3本目
— エクセルの神髄 (@yamaoka_ss) 2020年10月21日
画像のように1行目に見出し、A列に№が入っています。
№の行数およびデータ行数は毎回変化します。
この表の見出し(1行目)と№(A列)を残して、データ部分のみ値を消去してください。
※シートはアクティブシート pic.twitter.com/uXrvsihbHD
Sub ノック3本目() ActiveSheet.Range(Cells(2, 2), Cells(Rows.Count, Columns.Count)).ClearContents End Sub
#VBA100本ノック 4本目
— エクセルの神髄 (@yamaoka_ss) 2020年10月22日
画像のように1行目に見出し、A列に№が入っています。
この表範囲の一部には計算式が入っています。
(画像の最下行とD列には数式が入っています。)
データ行数は毎回変化します。
見出し行とA列№と計算式は残し、定数値だけを消去してください。
※画像ならB2:C11を消去 pic.twitter.com/kIe4Jns164
Sub ノック4本目() ActiveSheet.Range(cells(2, 2), cells(Rows.Count - 1, Columns.Count - 1)).ClearContents End Sub
#VBA100本ノック 5本目
— エクセルの神髄 (@yamaoka_ss) 2020年10月23日
画像のようにB2から始まる表があります。
B列×C列を計算した値をD列に入れ、通貨\のカンマ編集で表示してください。
ただしB列またはC列が空欄の場合は空欄表示にしてください。
例.D2にはB3×C3の計算結果の値を「\234,099」で表示、D5は空欄
※ブック・シートは任意 pic.twitter.com/zRBSVikFXL
Sub ノック5本目() With ActiveSheet Dim c As Long: c = .cells(Rows.Count, 2).End(xlUp).Row Dim i As Long For i = 3 To c If Not (.cells(i, 2).Value = "" Or .cells(i, 3).Value = "") Then .cells(i, 4).Value = .cells(i, 2).Value * .cells(i, 3).Value .cells(i, 4).NumberFormat = "\\#,##0" End If Next End With End Sub
感想と振り返り
賞味30分。
5本目について最初にFormat関数を使ってしまったことで文字列扱いになってしまい、手間取った。
基本的なもので難しい操作とかはないけど、Rangeクラスのプロパティとメソッドがうろ覚えで全然使い切れていないと実感。
精進あるのみ。
第3回 #VBAの悩みはVBAerに聞け に登壇させてもらいます!
はじめに
どうも初めまして、こんぺ と申します。
突然ですがこの度、TwitterのVBAクラスタ界隈で話題になっている「#VBAの悩みはVBAerに聞け」という勉強会に登壇させていただくことになりました!
「VBAの悩みはVBAerに聞け」とは?
こちらの勉強会は、かずやん 様(@y8bV4ty1wbkTjPd)が作った「#VBAの悩みはVBAerに聞け」のハッシュタグがきっかけとなり生まれた勉強会となっており、
しゃあ 様( @vba07529852 )が主催されてます。
#VBAの悩みはVBAerに聞け
— しゃあ@やっぱりVBAが好き (@VBA07529852) January 17, 2021
第3回開勉強会 on Zoom 催決定!
1月23日(土) 20時開宴
登壇いただくのは こんぺ(msj)さん!
5年前に作成したものと最近作成したものを2点ご紹介いただきます。https://t.co/j2Xd7ABGQC
チェケラ!
「#VBAの悩みはVBAerに聞け」というハッシュタグに関して、松田軽太 様が投稿された記事がとても分かりやすくまとめられています。
気になる方は是非ご一読ください。
また、どのようなことを過去の勉強会ではどのようなことをやったかについては、様々な方が記事にされています。こちらもぜひご一読ください。
そんなこんなで勉強会に向けてしゃあ様とやり取りする中、「勉強会で使うコードを公開してはどうでしょうか?」とご提案いただき、本ブログ記事を書いております。
「はじめてのマクロ」を作るに至った経緯
私の勤め先では、車通勤する社員に対し、会社に免許書や車検証など各証書のコピーを提出するという社内ルールがあります。
そして期限間近になると対象者に書類提出を促すための周知文書を作成する必要があり
- 提出書類ごとに期限間近の対象者を支店ごとにリストアップ
- 期限切れの社員はまとめて別項目にリストアップ
- この2つのリストを所定の様式(見た目)に加工
という至極単純なルーティーンが毎月あります。
5年前、入社したばかりでこのような簡単な業務をいろいろ振られていました。
ですが、半年後には
「この業務、面倒くさいし、ちょいちょいミスる、どうにかならんかExcelよ (´・ω・`)」
となっていました。
その時、大学講義で1度だけ触れたに「VBA」が頭をよぎり、「自動化で楽できるんじゃね?」と思い立ち… 早速参考書を購入。
参考書とインターネットにあるコードを写経、切り貼りして初めて書いたコードが下のものになります。
勉強会で用いるコード
※1 実際のコードとは一部標記を修正しています。
※2 Excelシートの画像については身バレの可能性が高くなることを憂慮し掲載しておりません。ご容赦ください。
Option Explicit Sub UpDateReport() Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long, r As Long, Check(2) As Date, Target(2) As Range, Name As Range, Namber As Range i = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False Sheet2.Range(Cells(7, 2), Cells(38, 9)).ClearContents Sheet2.Range(Cells(43, 2), Cells(51, 9)).ClearContents Sheet2.Range(Cells(43, 2), Cells(51, 9)).Interior.ColorIndex = 2 For k = 0 To 2 l = 7 '本社先頭 m = 11 'A支店先頭 n = 19 'B支店先頭 o = 28 'C支店先頭 p = 32 'D支店先頭 q = 43 '期限切れ先頭 For j = 3 To i Check(0) = Sheet1.Cells(j, 5) '免許証期限 Check(1) = Sheet1.Cells(j, 7) '車検証期限 Check(2) = Sheet1.Cells(j, 9) '任意保険期限 Set Target(0) = Sheet1.Cells(j, 5) '免許証期限 Set Target(1) = Sheet1.Cells(j, 7) '車検証期限 Set Target(2) = Sheet1.Cells(j, 9) '任意保険期限 Set Name = Sheet1.Cells(j, 4) Set Namber = Sheet1.Cells(j, 14) If k = 0 Then If Sheet2.Cells(3, 10) > CDbl(Check(k)) Then Name.Copy Sheet2.Cells(q, 2).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(q, 3).PasteSpecial (xlPasteValues) q = q + 1 ElseIf Sheet2.Cells(3, 11) > CDbl(Check(k)) Then If Sheet1.Cells(j, 3).Value = "本社" Then Name.Copy Sheet2.Cells(l, 2).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(l, 3).PasteSpecial (xlPasteValues) l = l + 1 ElseIf Sheet1.Cells(j, 3).Value = "E支店" Then Name.Copy Sheet2.Cells(l, 2).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(l, 3).PasteSpecial (xlPasteValues) l = l + 1 ElseIf Sheet1.Cells(j, 3).Value = "A支店" Then Name.Copy Sheet2.Cells(m, 2).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(m, 3).PasteSpecial (xlPasteValues) m = m + 1 ElseIf Sheet1.Cells(j, 3).Value = "B支店" Then Name.Copy Sheet2.Cells(n, 2).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(n, 3).PasteSpecial (xlPasteValues) n = n + 1 ElseIf Sheet1.Cells(j, 3).Value = "C支店" Then Name.Copy Sheet2.Cells(o, 2).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(o, 3).PasteSpecial (xlPasteValues) o = o + 1 ElseIf Sheet1.Cells(j, 3).Value = "D支店" Then Name.Copy Sheet2.Cells(p, 2).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(p, 3).PasteSpecial (xlPasteValues) p = p + 1 End If End If ElseIf k = 1 Then If Sheet2.Cells(3, 10) > CDbl(Check(k)) Then Name.Copy Sheet2.Cells(q, 4).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(q, 5).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(q, 6).PasteSpecial (xlPasteValues) q = q + 1 ElseIf Sheet2.Cells(3, 11) > CDbl(Check(k)) Then If Sheet1.Cells(j, 3).Value = "本社" Then Name.Copy Sheet2.Cells(l, 4).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(l, 5).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(l, 6).PasteSpecial (xlPasteValues) l = l + 1 ElseIf Sheet1.Cells(j, 3).Value = "E支店" Then Name.Copy Sheet2.Cells(l, 4).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(l, 5).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(l, 6).PasteSpecial (xlPasteValues) l = l + 1 ElseIf Sheet1.Cells(j, 3).Value = "A支店" Then Name.Copy Sheet2.Cells(m, 4).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(m, 5).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(m, 6).PasteSpecial (xlPasteValues) m = m + 1 ElseIf Sheet1.Cells(j, 3).Value = "B支店" Then Name.Copy Sheet2.Cells(n, 4).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(n, 5).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(n, 6).PasteSpecial (xlPasteValues) n = n + 1 ElseIf Sheet1.Cells(j, 3).Value = "C支店" Then Name.Copy Sheet2.Cells(o, 4).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(o, 5).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(o, 6).PasteSpecial (xlPasteValues) o = o + 1 ElseIf Sheet1.Cells(j, 3).Value = "D支店" Then Name.Copy Sheet2.Cells(p, 4).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(p, 5).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(p, 6).PasteSpecial (xlPasteValues) p = p + 1 End If End If ElseIf k = 2 Then If Sheet2.Cells(3, 10) > CDbl(Check(k)) Then Name.Copy Sheet2.Cells(q, 7).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(q, 8).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(q, 9).PasteSpecial (xlPasteValues) q = q + 1 ElseIf Sheet2.Cells(3, 11) > CDbl(Check(k)) Then If Sheet1.Cells(j, 3).Value = "本社" Then Name.Copy Sheet2.Cells(l, 7).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(l, 8).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(l, 9).PasteSpecial (xlPasteValues) l = l + 1 ElseIf Sheet1.Cells(j, 3).Value = "E支店" Then Name.Copy Sheet2.Cells(l, 7).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(l, 8).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(l, 9).PasteSpecial (xlPasteValues) l = l + 1 ElseIf Sheet1.Cells(j, 3).Value = "A支店" Then Name.Copy Sheet2.Cells(m, 7).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(m, 8).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(m, 9).PasteSpecial (xlPasteValues) m = m + 1 ElseIf Sheet1.Cells(j, 3).Value = "B支店" Then Name.Copy Sheet2.Cells(n, 7).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(n, 8).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(n, 9).PasteSpecial (xlPasteValues) n = n + 1 ElseIf Sheet1.Cells(j, 3).Value = "C支店" Then Name.Copy Sheet2.Cells(o, 7).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(o, 8).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(o, 9).PasteSpecial (xlPasteValues) o = o + 1 ElseIf Sheet1.Cells(j, 3).Value = "D支店" Then Name.Copy Sheet2.Cells(p, 7).PasteSpecial (xlPasteValues) Target(k).Copy Sheet2.Cells(p, 8).PasteSpecial (xlPasteValues) Namber.Copy Sheet2.Cells(p, 9).PasteSpecial (xlPasteValues) p = p + 1 End If End If End If Application.CutCopyMode = False Next Next Application.ScreenUpdating = True Application.CutCopyMode = False End Sub
その後
このコードを書き上げ、30分くらいかかっていた作業がワンクリックで終わるようになると、そこにひとりのVBAerが誕生していました。
そのVBAerはすっかり気をよくして、手の届く業務範囲で自動化を押しすすめ、身の丈に合わない依頼を引き受け盛大にズッコケたりしました。
…そんなこんなで時は5年たち、まさかのVBA勉強会に無謀にも立候補。
公開できるよう一部修正するため、5年前に自身が書いた渾身のコードを読み返すことに…
( ^ω^)・・・
無駄に長ぇなぁオイ!(# ゚Д゚)
まぁ。プログラミングの基本や作法も全然わかっていないときに書いたコードなので、いろいろとご容赦ください…
というわけで、当初の内容から少し変わって
↓ のようになりました!
第3回のイベント内容に異変が!!
— しゃあ@やっぱりVBAが好き (@VBA07529852) 2021年1月19日
なんとなんと!
リアルタイム リファクタリング!
過去作プログラムを、機能を変更せずにより洗練されたコードに再構築!
他人の生のコーディングを見られる機会なんてめったにないぞ!
Don't miss it!#VBAの悩みはVBAerに聞け https://t.co/LGTyGqZBNO
この無駄に長いコードを無謀にも生リファクタリング!
5年でいろいろズッコケたおかげでスキルアップしている…はずですが、あまり期待はしないでください…
その他話題にしたいなぁ…と漠然と思っていることは
- 今の自分がこの作業を改めて自動化するならどうするか
- 「自分で使うマクロ」と「人に使ってもらうマクロ」を組む時に考えていること
など「プログラミングの考え方」や「VBAをつかった業務改善」のことなどをメインとしてVBAerの皆様と意見交換できればいいなぁ、と考えております。
夢の先をめざせ!~PIRAMIRiSEの記憶~
12/13~14に開催されたぴらみさんこと、平山笑美さんの1thソロライブ「PIRAMIRiSE」に1日目に参加してきました。
もう一曲一曲感想を書き倒したい勢いですが、一番言いたいことがぼやけてしまうので割愛…
今回のライブは本当に夢のような時間でした。実際に翌朝はライブのことを思い出すと夢を見ていたような錯覚に陥ってましたし。。。
そんなぴらみさんの初ソロライブは本当に『ぴらみさんのために』という思いが溢れ出ていたライブだったと思います。
入場が開演ぎりぎりになってしまい最後列、スピーカーの後ろから観ていたので、ぴらみさんの歌声120%浴びることはできなかったのは正直ちょっと残念…でしたが、それでもぴらみさんの姿をはっきりと見ることができたし、なにより「フロアにいるファンの様子」も終始観ることができたのがよかったです。ぴらみさんの歌声に集中していた中で2割くらい「会場の雰囲気」を傍観していた自分がいました。さながら「ぴらみさんの生歌を聞きながら一足先にライブBDを見ていた」感覚。
自分自身そんなにライブに参加したことがないので比較できませんが、このライブは関係者のみならず、ファンの「情熱」がすごかったです。
ミリオンライブをきっかけにファンになった人が多いためか、初披露の新曲に対してもしっかりコールを入れるあたり「さすが同僚やな…」とコールし、「JUMP!」「May be,May be,May be」と「フライング・ハイ!」ではファンの気持ちが爆発してました…。
それでも「500人オールスタンディング」って会場にもかかわらず終始平和に終わったことにこのライブの「本質」を感じた気がします。
このライブは皆さんご存じの通りクラウドファンディングにより楽曲作成からライブの実現に至った経緯があります。
(↓ プロジェクトのリンク。フォローしてない人は登録、登録ぅ!)
fanbeats.jp
「ライブに行く」っていう行為は普通「ライブ会場という楽しい場所」が提供されていて、そこに「自分が楽しくなるため」「自分が気持ちよくなるため」にするという側面があると思うんです。だからというべきか、迷惑行為を禁止するアナウンスがあっても「自分が楽しければいい」というような立ち振る舞いをする観客がいるライブもあるんだと思います。
でもこのライブは成り立ちがそもそも全然違います。
無事に終わった今だからこそ言えますが、「ライブが実現できなかった」という可能性もあったんです。「ライブをしたい」という「ぴらみさんの夢」に「ぴらみさんの可能性」を見出してくれた「クリエイター・関係者の情熱」、そして「ぴらみさん自身の歌が聞きたい」という「ファンの夢」のなに一つが足りていなくても実現しなかった時間でした。「自分が楽しくなる」という気持ち以上に「ライブの実現」という一つの目標にファンも必死だったんだと思います。
そのためか、「おめでとう」「ありがとう」っていう言葉をいう機会はあったけど、その言葉の副音声に「ずっと待ってた!」「これからも応援したい」「絶対成功させる!」っていう熱い思いを一人一人乗せてた気がします。(幻聴だったらすみません)
1日目のMCでぴらみさんが噛んでしまった(かわいかったです)あと、「そっか…そうだよね、私のためにきてくれたんだもんね…」とつぶやいていましたが、この言葉が本当に嬉しかったです。
「あなたの夢が私の夢だから…」という昨今の漫画やゲームにすら出てこないような「純粋な献身」で実現した空間が荒れるはずがないです。
みんなの夢が実現したからこそ「夢のような時間」だったのかな、と夢心地から覚めてきて振り返っています。
そして!2ndアルバム作成&2ndライブ開催が決定!!やったぜ!
これからも応援し続けねば…
「夢のような時間」が終わって、ぴらみさんの未来図が描かれたからこそ、『Perfect Place』のこの歌詞で締めたいと思います。
終わることのない世界 夢の先を目指せ!