重複の有るリストから各要素数をカウントするマクロ

今宵もExcelマクロのお勉強

今回は『重複の有るリストから各要素数をカウントするマクロ』です

果たして、聞いただけでは何をするマクロなのかよくわからない可能性があるので、早速本題へ

先ずはこちらを見て欲しい

エクセルではよくありがち？なリスト

項目に「氏名・所属・出身県・年齢・サークル」が存在しております

そして、「あ～の」さんまでがリスト化されております

今回ここでやりたいのは、じゃあ各県別の出身者数はどれくらい？

たとえば、福岡県出身の人の数は？熊本県出身の人の数は？と聞かれた場合

営業部は何人？人事部は何人？とかとか

一番原始的は方法は、目視で一つ一つ数えていくこと

少しスマートなやり方になると、フィルターをかける方法とかある

もちろん画像のような26行しかないリストなら目視で数えてもいいのでしょう

しかし、これが数百行、数千行に及んだら？目視で数えていくことは現実的ではありません

フィルターをかけるにしろ、要素数が多いとその分時間がかかります

そんなときは、Excelマクロにおまかせ！ボタン一つであら不思議

勝手に数えてくれちゃいます( *´艸｀)めんどくさい仕事はExcelにおしつけちゃいましょうね～

【使い方】

①数えたい項目にカーソルを合わせます

②マクロを実行します

③終わり

あら簡単！(/・ω・)/

出身県で実行した結果

所属で実行した結果

この通り、各要素別に数をカウントしてくれます

今回は結果の出力を【MsgBox】で行っておりますが、MsgBoxは正直オススメではありません

実際は数えた後、表にしたり、別のデータとしてリスト化したりするだろうからである

個人的にオススメなのは、ユーザーフォームのテキストボックスに出力するやり方

これなら、結果をコピーすることが可能なので、2次データとして扱いやすいです

しかし、ここではユーザーフォームの説明はしません(*'ω'*)

サークルで実行した結果が少し特殊

ご覧の通り、未所属（空欄セル）もカウントします

これは最終行の取得が上から下に見るのではなく、下から上にみた結果の賜物

ところが弱点もあります

詳しく説明はしませんが、わかるひとにはわかると信じたいと思います

万が一、使われる人がいるかもしれないので、少し仕様

・複数セル選択しているときは実行できません

・カウントは選択しているセルから下方向に行われます。上方向は無視されます

・30万行以上あるリストでは動きません

・結果の出力はMsgBoxで行っておりますが、何か別の方法にしたほうがよさげ

以上、要素数をカウントするマクロでした(*'ω'*)

Sub Count()

 

    Dim SelRow As Long
    Dim SelCol As Long
    Dim MaxRow As Long
   
    Dim Dict As Object
    Dim buf As String
    Dim KeyAll
    Dim Cnt As Long
    Dim ResultStr As String

 

    If Selection.Count <> 1 Then
        MsgBox "複数セルが選択されています。選択可能なセルは単一セルのみです。"
        Exit Sub
    Else
        SelRow = Selection.row
        SelCol = Selection.Column
    End If
   
    MaxRow = Cells(Rows.Count, SelCol).End(xlUp).row
   
    If MaxRow = 1 Or MaxRow > 300000 Then
        MsgBox "行数が多すぎるか、不正です。確認してください。"
        Exit Sub
    End If
   
    Set Dict = CreateObject("Scripting.Dictionary")
   
    For i = SelRow To MaxRow
        buf = Cells(i, SelCol).Value
        If Not Dict.Exists(buf) Then
            Dict.Add buf, buf
        End If
    Next i
   
    KeyAll = Dict.keys
   
    For j = 0 To UBound(KeyAll)
    Cnt = 0
        For k = SelRow To MaxRow
            If Cells(k, SelCol).Text = KeyAll(j) Then
                Cnt = Cnt + 1
            End If
        Next k
       
        ResultStr = ResultStr + KeyAll(j) & vbTab & Cnt & vbCrLf
       
    Next j

 

    MsgBox ResultStr
   
End Sub

 

2020年春シーズン開幕の狼煙【佐世保エギング】

春はあけぼの。やうやう白くなりゆく山際、少し明かりて、紫だちたる雲の細くたなびきたる。

これは枕草子の一節

どういうことかと言うと、春にエギングをするなら夜がほのぼのと明けようとする朝マヅメの頃が良いということである

そんなこんなでごきげんよう。私です

私の中では勝手に2020年3月からエギング春シーズンが始まっておりますが、なぜだか3月はイカ０匹(´・ω・｀)

春シーズン開幕の狼煙があがらないまま、3月を終えてしまいましたが、今宵とうとう私にも春イカが降臨してくれました

それがコイツです！

ちっこ( *´艸｀)

なんだこいつはぁ～たまげたなぁ

下手したらエギより小さいのでは？といった感じ

時刻は午前1時半。私にしては珍しく夜釣り

小さくてもイカはイカ。。。ここに私の春シーズン開幕を宣言させていただきます！

次に動きがあったのは午前4時過ぎ

アジの時合いに突入～

4月も半ばですが、アジいます( *´艸｀)

結局アジの時合いは朝日昇るまで続き、計15匹をGet!

大本命朝マヅメはもちのろんエギング

朝日昇ってもアジの時合いが続いたので、アジ釣り続けようかだいぶ迷ってしまったのはここだけの話...

正直アタリは全然わかりませんでしたが、しゃくりアワセでヒット

2月15日以降、約2か月ぶりのイカ！正直しびれましたじぇ

寄せてくるとこれまた良いサイズ

なんか引くと思ったわ～( *´艸｀)

YATTAZE！

よかったら動画もどうぞ

www.youtube.com

2020年春シーズンが開幕の狼煙が上がらない

2020年3月も下旬に突入した今日この頃

みなさんイカ釣れていますか？私は釣れていません！>_<

まさかの3月に入ってイカ0匹

全然春シーズン開幕の狼煙が上がりませんね～(´・ω・｀)

困った困った。。。因みに2019年は3月2日にイカが釣れている！

このままでは3月中でのシーズン開幕宣言が厳しくなってきますが、これも釣り

仕方ないね(/・ω・)/

そんなわけで本日はエサ釣りの記事

イカは釣れねど、魚はいます！

初春の堤防で、サビキ釣りとフカセ釣りを満喫してきました～

メバル2匹

アジ1匹

カサゴ2匹

メジナ1匹

釣り開始は朝日昇ったばかりの６：３０

釣り開始から1時間半はメバル連打

狙いはアジということもあったので、沢山釣れたメバルもほとんどはリリース

サイズも小ぶりでしたからね。。。(´・ω・｀)

釣れた中では比較的大きかった2匹はキープしてしまいました

※画像はいずれもリリースした個体

メバルと戯れること1時間半

メバルしか釣れない状況を打破しようとフカセ釣りへ移行

すると、釣れてきたのは・・・

待望のアジ！

朝８：００ようやく待ちに待ったアジの時合い突入です

サビキ仕掛けに再度変更し、アジを狙う

その後、アジの時合いは1時間半ほど続きますが、９：３０ごろには群れも去りアジは全く釣れなくなりましたとさ

アジが去った後は、再度フカセ釣りにチェンジし何か狙い

私にしては良型のメジナも釣れ、初春の堤防釣りは割と満足のいく釣果となりました( *´艸｀)

イカが釣れず撃沈気味のこの頃でしたが、エサ釣りならお魚と戯れることができよかったよかった

何とか3月中に私の春シーズン開幕宣言を出したいところですが、果たしてどうなることやら

よかったら動画もどうぞ

www.youtube.com

2020冬シーズンのイカマップ

2019年12月～2020年2月までのエギング結果を【2020年冬シーズン】としてイカマップを作成してみました

【佐世保エリア】

【西海エリア】

2020年冬シーズンでの釣果はなんと！

4匹>_<

渋々でしたね～全然釣れませんでした！

なんといっても特出すべきは、西海エリアの存在です

2019年春～2019年秋シーズンまで佐世保市一本でやってきた私も、さすがにムリ！

佐世保市を飛び出して、西海市におじゃましちゃいました

それでは釣れたイカちゃんたちを日付順にご紹介

2019年12月15日　深浦漁港

2020年2月2日　寺島の高堤防①

2020年2月2日　寺島の高堤防②

2020年2月15日　猫堤防

以上！4匹！！

Youtubeへの動画投稿活動もやっておりますが、なかなかイカが釣れない中で私を救ってくれたのは「アジ」の存在でした

アジ君ありがと～(/・ω・)/

よかったら長崎の仙人チャンネルもご贔屓にお願いいたしやす

www.youtube.com

2020年3月より、私の中で勝手に2020年春シーズンが開幕しておりますが、未だイカはなし！

私にとって2年目の春シーズンですが、2019年同様楽しめたらいいなと思っております

初春の佐世保市デイアジング

アジ爆釣！( *´艸｀)

わしの水くみバケツはお陰様で満員御礼でございます

イカが釣れない私は、エギングを諦めいつも通りエサ釣りへと移行

やっぱりエサ使った釣りは何かしら釣れてくれるのでいいですね！

２５ｃｍくらいのメジナ

１８ｃｍくらいのメジナ

そしてアジが入れ食い

2連でくることも！

釣行日は3月1日でした

とうとう3月に入ってしまいましたね(/・ω・)/

イカが釣れな過ぎて、なんとなくサビキ釣りへ

始め行こうとしていた釣り場は深浦漁港でしたが、人が多すぎて残念...>_<...

何気なしに秘密の堤防を覗いてみると、全然人が入っていなかったので久しぶりに秘密の堤防で釣りをすることに

釣り初めはボトム付近を執拗にねちっこくサビキ仕掛けで攻めておりましたが、一向に釣れない...

ためしに表層付近を探ってみると、、、

いましたアジ君(*'ω'*)

しかも大量に

正解は表層でした！

水くみバケツに入りきらなくなったので、仕方なく終了しちゃいましたが、釣り続ければまだまだ釣れそうな感じでした

結局持ち帰ったアジは24匹でしたが、2日で全て食べちゃいました('ω')ノ

今度は沢山持ち帰れるようクーラーボックスもってこよう。そうしよう

よかったら動画もどうぞ

www.youtube.com

エクセルのファイル（ブック）同士を比較するマクロ

エクセルマクロのお勉強

前回は致命的欠陥を持ちつつも、エクセルのシート同士を比較するマクロを苦心して完成させることができました

nagasaki.hateblo.jp

シート同士比較できるなら、ファイル同士も比較できるのではないかと考え、今回はファイル同士を比較するマクロを作成してみました

※ソースコード全文は記事の最後に

２つのファイル同士を比較するので当然２つのエクセルファイルを選ぶ必要がありますが、これは簡単！

「Application.GetOpenFilename」を使ってユーザに選んでもらいましょう

変数「OrgBookPath」、「RevBookPath」に比較するファイルをそれぞれ格納

皆さんのために、今回だけ特別に「.csv」も比較できるようにしときました！( *´艸｀)

ｶﾝｼｬｼﾀﾏｴ

２つのファイルを選択する上で、一つケアしておきたいのがファイル名です

詳細は省きますが、パスさえ異なれば同じ名前であろうがファイル自体は存在できます

しかし、開こうと思ったら話は別。。。同じファイル名のファイルを同時に開くことはできません

そこで、今回は比較しようとしている２つのファイル名が同じかどうかだけはケアしておくことにします

ファイルの比較処理

ここに、２つのファイルが存在します

A.xlsx と B.xlsx

各ファイルにはそれぞれ「シート」を持っています。持っているハズですぅ

そこでファイル同士を比較する際、比較する２つのファイルの中で同一シート名のものを比較するということで今回はマクロを組んでみました

つまりどゆことかと言いますと

A.xlsxには「Sheet1」、「Sheet2」、「Sheet3」

B.xlsxには「Sheet1」、「Sheet2」、「Sheet3」、「Sheet4」

両ファイルに存在している「Sheet1」、「Sheet2」、「Sheet3」を比較対象として認識するということです

B.xlsxに存在する「Sheet4」は比較対象として認識しません

ここまでコード化できたら、後は簡単

シート同士の比較は前回作成しておりますので、コードは全文流用しちゃいましょう

前述、致命的欠陥を抱えているとお話しましたが、以下の欠陥を抱えております

●ひらがな・カタカナの区別ができません

●大文字・小文字の区別ができません

比較処理としては致命的だな！

それでもよろしければ、ソースコードどうぞ

ヒマがあれば欠陥に対してもなおしていきますぅ～

●以下ソース

Private Sub FileHikaku()

 

    Dim OrgBook As Workbook
    Dim RevBook As Workbook
    Dim OrgBookPath As String
    Dim RevBookPath As String
    Dim OrgBookName As String
    Dim RevBookName As String
   
    OrgBookPath = Application.GetOpenFilename(filefilter:="Excelブック,*.xls?;*.csv")
    RevBookPath = Application.GetOpenFilename(filefilter:="Excelブック,*.xls?;*.csv")
   
    OrgBookName = Mid(OrgBookPath, InStrRev(OrgBookPath, "\") + 1)
    RevBookName = Mid(RevBookPath, InStrRev(RevBookPath, "\") + 1)
   
    If OrgBookName = RevBookName Then
        MsgBox "Same File Name!"
        End Sub
    End If
   
    Set OrgBook = Workbooks.Open(OrgBookPath)
    Set RevBook = Workbooks.Open(RevBookPath)

 

    Dim OrgSheetName As String
    Dim RevSheetName As String
    Dim OrgStr As String
    Dim RevStr As String
    Dim MatchNameBool As Boolean
    Dim r As Range
    Dim s As Range
    Dim OrgRng As Range
    Dim RevRng As Range
    Dim row As Long, col As Long
   
    For i = 1 To OrgBook.Worksheets.Count
    DoEvents
   
        MatchNameBool = False
        OrgSheetName = OrgBook.Worksheets(i).Name
   
        For j = 1 To RevBook.Worksheets.Count
        DoEvents
           
            If OrgSheetName = RevBook.Worksheets(j).Name Then
                MatchNameBool = True
                Set OrgRng = OrgBook.Worksheets(i).UsedRange
               
                For Each r In OrgRng
                DoEvents
               
                    OrgStr = r.Value
                    If Len(OrgStr) > 0 Then
                   
                        row = r.row
                        col = r.Column
                       
                        Set RevRng = RevBook.Worksheets(j).Cells(row, col)
                        RevStr = RevRng.Value
                       
                        If StrComp(OrgStr, RevStr, vbTextCompare) <> 0 Then
                            RevRng.Interior.Color = RGB(255, 255, 0)
                        End If
                   
                    End If
               
                Next r
               
            End If
   
        Next
       
        If MatchNameBool = False Then
            OrgBook.Worksheets(i).Tab.ColorIndex = 3
        End If
       
    Next
   
    row = 0
    col = 0
    OrgStr = ""
    RevStr = ""
    MatchNameBool = False
    Set OrgRng = Nothing
    Set RevRng = Nothing
   
    For m = 1 To RevBook.Worksheets.Count
    DoEvents
   
        MatchNameBool = False
        RevSheetName = RevBook.Worksheets(m).Name
   
        For n = 1 To OrgBook.Worksheets.Count
        DoEvents
           
            If RevSheetName = OrgBook.Worksheets(n).Name Then
                MatchNameBool = True
                Set RevRng = RevBook.Worksheets(m).UsedRange

                For Each s In RevRng
                DoEvents
               
                    RevStr = s.Value
                    If Len(RevStr) > 0 Then
                   
                        row = s.row
                        col = s.Column
                       
                        Set OrgRng = OrgBook.Worksheets(n).Cells(row, col)
                        OrgStr = OrgRng.Value
                       
                        If StrComp(RevStr, OrgStr, vbTextCompare) <> 0 Then
                            OrgRng.Interior.Color = RGB(255, 255, 0)
                        End If
                   
                    End If
               
                Next s
               
            End If
   
        Next
       
        If MatchNameBool = False Then
            RevBook.Worksheets(m).Tab.ColorIndex = 3
        End If
       
    Next
   
    MsgBox "kanryo!"
   
End Sub

長崎市の釣り人イノシシに襲われるも返り討ち？まじかよ(´・ω・｀)

まじかよ(´・ω・｀)と思うようなはなし

3連休も終わり、私も本日から普段通りのお仕事開始

みなさんいかがお過ごしでしょうか？私です

3連休はなんと3日とも釣りに出かけてしまった私ですが、結果は大惨事

悲惨ですよ！悲惨

エギングで空振るのは、まぁOK

いくら暖冬と言えど、2月ですよ

本当は釣りたかったけど、厳しくて結構。渋くて結構！

だが、餌釣りも空振りとなると頭痛いですわ～(/・ω・)/

佐世保市・西海市で2日間フカセ釣りに興じてみるも、結果は全然ダメでした～

まじかよ(´・ω・｀)

そして、もう一つ。まじかよ！？と言いたくなる事件が長崎市で発生しております

www.nikkei.com

海からイノシシ襲来、襲われた釣り客が返り討ち

①海からイノシシ襲来

②釣り人がイノシシに襲われる

③返り討ちにする

思わずはぁ？と言いたくなるような出来事ですが、怖い世の中になったものですわ～

襲われたのが私だったのなら、③「返り討ち」は「死亡」に置き換わってたかもしれんな！

長崎の仙人、海から来たイノシシに襲われ死亡

冗談きついで！(; ･`д･´)

イノシシが泳げるということは知っていましたが、まさか釣り中に出くわすなんて思って釣りしてる人なんて皆無でしょう

イノシシが離島に上陸という話もよく耳にします

また、イノシシの怖いところは人間に向かってくる（こともある）ところですかね

シカなら逃げようとしますが、イノシシは向かってくる>_<

詳細なことは知りませんが、泳いで疲れてただろうに一服でもしてればいいものを、そこらへんにいた釣り人に向かっていく野生

猪突猛進という言葉がありますが、触らぬ神に祟りなしという言葉もある

この場合、触ったのは人間様でしたが・・・

次回の釣行から「もしかしたら海からイノシシが襲ってくるかもしれない」と身構えて釣りに興じることにしましょう( *´艸｀)

具体的にどう身構えるのかって？

ご安心くださいネットで調べたところ、香川県より「イノシシ等が出没したときの対応マニュアル」が公開されています！

サンキュ、香川！

https://www.pref.kagawa.lg.jp/kankyo/data/1105/pdf/manual.pdf

ふむふむ、どれどれ？

マニュアルによると、イノシシが出没したときは

①個々の役割の明確化

②連絡体制の整備をしとく

そかそか、なるほど、、、

これで安心だぜ(*'ω'*)

そんなわけあるかい！

基本的にイノシシと出くわしてしまったら

①何もせず放っておく

②ゆっくりと後退し、静かにその場を立ち去る

③決して威嚇したり、追い払おうとしない「ましてや返り討ちなど・・・」

私はこれからも釣りに行きますが、どうかこの記事がフラグになっていないことを祈る('ω')