VBA DictionaryオブジェクトのItemが複数欲しい！（クラス編）

こんにちは。
派犬事務員のコロ子です。

新しい首輪　Amazfit Band 5

以前に書いたブログのコードを見て「なんだコレ？」っていう変なコードがいっぱいある。なんか変だけど、そのときは真剣に書いていたから、それはそれでそのままにしておこう。「それは違ーーーう！！」と指摘してもらえたら嬉しいし。なんだコレ？のついでに、最近思いついたコードを載せてみよう。

DictionaryのItemが複数欲しい

Dictionaryオブジェクトのアイテムが複数欲しい！と思う事ない？
例えばこんなとき。
社名をキーにして、各商品の金額をアイテムに入れて合計を集計したい。

キー1つに対してこんなイメージで複数アイテムが欲しい。

Dictionaryオブジェクト.Add Key, Item1, Item2, Item3・・・
（あくまでもイメージ）

そうは言っても、キー1つに対してアイテム1つ。
アイテムにはオブジェクト型を入れる事も可能なので、複数の変数を用意したクラスを入れよう。

作り方

①クラスモジュールを作る
クラス名：Variable

②VariableクラスにPublic変数を3つ用意する
Public SampleA As Long
Public SampleB As Long
Public SampleC As Long

③コード（Sheetモジュール）

Sub Sample()

Dim dic As Dictionary
Set dic = New Dictionary

Dim i As Long
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

    Dim dickey As String
    dickey = Cells(i, 1).Value
    
    If dic.Exists(dickey) = False Then
    
        'クラスのインスタンスを生成
        dic.Add dickey, New Variable

    End If
    
　'生成した変数に金額を足していく
    dic(dickey).SampleA = dic(dickey).SampleA + Cells(i, 2).Value
    dic(dickey).SampleB = dic(dickey).SampleB + Cells(i, 3).Value
    dic(dickey).SampleC = dic(dickey).SampleC + Cells(i, 4).Value
    
Next i

'確認
Dim buf As Variant
For Each buf In dic.Keys

    Debug.Print buf, dic(buf).SampleA, dic(buf).SampleB; dic(buf).SampleC

Next buf

とりあえず急場はしのげた。
普通はこうするとか、もっと良い方法ありますか？
↓
Dictionaryオブジェクトを配列にする方法を教わった！
koroko.hatenablog.com
↓
アイテムを配列にする方法
koroko.hatenablog.com

VBA 結合セルを扱う（正しい方法）

こんにちは。
派犬事務員のコロ子です。

前回の記事を書いたら、MergeAreaプロパティを使えばいいんじゃない？
と教えて頂いた。

koroko.hatenablog.com

MergeAreaプロパティ、こんな便利なものがあったなんて！！！

「練習のために○○は使わないでコードを書いてみましょう」的な事をしているのではなくて、素で知らなかった。
知らないと「VBA道場で修行的なコード」「体育会系に鍛錬的なコード」になっちゃう。修行も鍛錬も好きじゃないからー！！

表

MergeAreaプロパティは「結合されているセル範囲のRangeオブジェクトを返す」とのことなので、例えば
Range("B6").MergeArea(1).Value
と書くとB6セルを含む結合範囲の1番目のセルの値が取得できる。
ちなみに
Range("B4:B10").MergeArea.Value
とか
Range("B4:B10").MergeArea(1).Value
と書きたくなるけど
Range("B6").MergeArea(1).Value
Rangeの中身は単独セルを書かないといけない。

では、早速MergeAreaプロパティを使って書き直そう。

Sub Test1()

Dim ran As Range

For Each ran In Range("D4:H17")

    Debug.Print "日付：" & _
                Cells(2, ran.Column).MergeArea(1).Value & _
                Cells(3, ran.Column).Value
                
    Debug.Print "サンプル名：" & _
                Cells(ran.Row, 2).MergeArea(1).Value
                
    Debug.Print "ロット番号：" & _
                Cells(ran.Row, 3).MergeArea(1).Value
                
    Debug.Print "データ：" & ran.Value

Next ran

End Sub

えっつ！！これだけ？超簡単じゃん！
めちゃめちゃスッキリ！

VBA 結合セルを扱う

こんにちは。
派犬事務員のコロ子です。

あるシステムからデータをダウンロードすると、こんな感じのエクセルの表になって落ちてくる。

表1

見やすいようにセルが結合されている。
わざわざそういう風に作ってくれているのはありがたいけど、これを加工するとなるとちょっと扱いにくい。

結合されたセルの扱いについて考える

A1～A4が結合されている場合

結合セルA1：A4を選択するには、セルの範囲のどこを指定しても結合セルが選択される。
Cells(1, 1).Select
Cells(2, 1).Select
Cells(3, 1).Select
Cells(4, 1).Select
上記4つは全部同じ動きをする。

値を取るのはどうだろう。
Cells(1, 1).Value　←このときだけ値が取れる　
Cells(2, 1).Value　←空が取得
Cells(3, 1).Value　←空が取得
Cells(4, 1).Value　←空が取得
値は結合の一番上のセルでのみ取得可能。
確かにセルの結合を解除すると一番上のセルに値が入って他のセルは空欄になる。
なるほど、こういう仕様かぁ。

ちなみに、

①のように横に結合されている場合は一番左のセル（B2セル）
②のように縦横に結合されている場合は一番左上のセル（B4セル）
で値が取れる。

仕組みが分かったので、表1からサンプル名を取得してみる。

Sub SampleName()

Dim i As Long
For i = 4 To 17
    If Cells(i, 2).Value <> "" Then
        Debug.Print Cells(i, 2).Value
    End If
Next i

End Sub

次に、表1より「日付」「サンプル名」「ロット」「データ」を取得してみる。
Selectionで結合セルを選択して、アドレスから値を取得する方法でやってみる。

Sub データ()

    Dim ran As Range
    
    For Each ran In Range("D4:H17")
    
        Debug.Print "日付：" & セルの値_日付(ran, 2)
        Debug.Print "サンプル名：" & セルの値(ran, 2)
        Debug.Print "ロット番号：" & セルの値(ran, 3)
        Debug.Print "データ：" & ran.Value
    
    Next ran

End Sub

Function セルの値(ran As Range, c As Long) As String
'引数cは列番号
    
    Cells(ran.Row, c).Select

    Dim myAdress As Variant
    myAdress = Split(Selection.Address, "$")
    
    Dim r As Long
    '単独セルの場合
    If InStr(Selection.Address, ":") = 0 Then
        r = myAdress(2)
    '結合されている場合「：」を除く
    Else
        r = Left(myAdress(2), Len(myAdress(2)) - 1)
    End If
        
    セルの値 = Cells(r, c).Value
    
End Function

Function セルの値_日付(ran As Range, r As Long) As String
'引数rは行番号

    Cells(r, ran.Column).Select

    Dim myAdress As Variant
    myAdress = Split(Selection.Address, "$")
    
    Dim c As String
    c = myAdress(1)
        
    セルの値_日付 = Cells(r, c).Value & Cells(r + 1, ran.Column).Value

End Function

・セルのアドレスは$B$4:$B$10のような形になっているので、＄で区切って配列に入れる。
・縦に結合されている場合は、配列の2番目が行番号。「：」が入っていないなければ単独セル。「：」が入っている場合は：を除く。
・横に結合されている場合は配列の1番目が列番号。列番号は英文字で取得。

この場合Selectionでセルを選択しているのでマクロ実行中は絶対にエクセルを触らないように注意。

******************************************

この記事を公開したら正しい方法を教えてもらった。
こちらをチェック
↓
koroko.hatenablog.com

【恐怖】VBA Workbooks.Openでファイルが消える！

こんにちは。
派犬事務員のコロ子です。

何年か前に作ったマクロで事件が起きた。

Aさん：「コロ子！大変！！！ファイルが無くなっちゃった！！！」
コロ子：「え！？どうしたんですか？」
Aさん：「間違った入力をしてボタン押したら、ファイルが無くなっちゃったの！」

え！？そんな事ある？？
確認してみると、フォルダ内にあるはずのファイルが消えている。
コードを見てもファイル削除の処理は入っていない。
ファイルが無くなったのはマクロのせいじゃないよ、と思いながらフォルダの中に適当なファイルを入れて同じように実行してみたら、ファイルが消えている！
ファイル削除の処理は入ってないのに！何で！？

どうやら
入力が間違っていたことが原因でファイル名が取れず、ファイル名が空の状態でファイルオープンするとエラーが起こり（これは当然）、そしてフォルダ名の配下のファイルが削除される、らしい。
更に、削除されるファイルとそうでないファイルがある。

Dim fileName As String

fileName = ファイル名を取得する処理　←何らかの原因で””（空）が入る

Workbooks.Open フォルダ名 & "\" & fileName　←ファイル名が空で開く

原因究明のために自分のPCに同じような環境を作ってマクロを実行してもファイルが消えない。
どうやっても再現できない。

分かった事

①ファイル名が空("")でWorkbooks.Openを実行するとパス配下のファイルが削除される
②ネットワーク上で起こる（ローカル環境では起こらない）
③ファイル名の先頭文字がアルファベットのものは削除されない

確かに雑なマクロを作ったコロ子が悪い。
でもファイルが削除されるなんて酷過ぎる！Workbooks.Openでファイルが削除されるなんてどこにも書いてないよ！
たまたま重要なファイルがアルファベットから始まっていたので今回は助かった。でもそうじゃなかったら本当にヤバイ！！
これって、本当に死んじゃうやつだよ！

Microsoftさん、こんなのありですか！！！！

使うの自分だけだからとか、限られたグループで使うだけだからエラーが出てもまあいいや、みたいな作り方してると超危険。
必ず、ファイル名がある事を確認してからファイルを開くべし！

Dim fileName As String

fileName = ファイル名を取得する処理

If fileName <> "" Then

    Workbooks.Open フォルダ名 & "\" & fileName
    
End If

1年を振り返る（ノンプロ犬、エセプロ犬になる）

こんにちは。
派犬事務員のコロ子です。

今年もノンプロ研アドベントカレンダーに参加しました！
この記事は「ノンプロ研 Advent Calendar 2020」の3日目です。

adventar.org

今年は「派犬事務員」として大きな転機があった。
18年間所属した部署から新しい部署に異動になった。

異動の経緯

実は「辞める」と言った事が発端だった。

仕事や会社に不満というより（いやいやめっちゃ不満あったけど）、18年勤めて派犬という立場ではもうこれ以上どうにもならないと思った。
このままずーっと派犬のままなのか。何も変わらず、このまま一生この会社に飼われるのか。
そんなの嫌だ。派犬、派犬、派犬って毎日犬扱い（犬だけど）にはもううんざりだ。
もう嫌だ！！もう辞める！
次は決まってないけど、別れなければ出会いはない！！
勢いよく飛び出した。
つもりだった。

所長（以前上司だった）：「コロ子、辞めるんだって？」
コロ子：「はい。長い事お世話になりました。」
所長：「次はどうするの？」
コロ子：「・・・まだ決まってません・・・」
所長：「まだ次決まってないなら、コロ子に頼みたい仕事があるんだけど。」
と言って分厚いファイルを見せてくれた。
所長：「こういうのアナログに手作業でやっていて大変なんだ。なんとか上手いことシステム化できないか考えてくれないか？外注するのも大変なんだ。他にもこういうの沢山あるんだ。」

えっ。本当に？
そういうの考えるの好き。面白そう。
でも、できるかな？できるかも？やってみたい！

あっけなく元さやに戻る。

一人部署

ということで部署異動で、総務の一角に机を置くことになった。
総務だからいろんな人が来る。
「あれ？コロ子何でここにいるの？えっ？異動？マジで？何で何で？前の部署イヤになっちゃったの？」
前の部署イヤになったのバレてる・・・。
一度辞める宣言しちゃった後だから気まずい。
総務にいるのに総務の仕事できない役立たず感が半端ない。めっちゃ浮いてる状態で新しい仕事は始まった。

なぜかモチベーションが下がる

コードを書いている時は楽しい。以前のようなルーチンワークを持っていないので集中して作れる。憧れのVBA三昧。
しかし、以前も孤独に悩んでいたけど、結局は一人部署なので誰も相談できる人がいない。
ノンプロ研で相談できるけど、具体的な仕事の内容はなかなか相談できない。
行き詰るとそこから一歩も進まなくなる。
また、「ここはどうしますか？」とメールをしても、なかなか返事が返ってこない。微妙な待ち時間が多い。
空いた時間に勉強しようと本を見るも、授業中に隠れて漫画を読んでるみたいな気分になって落ち着かない。

エセプロになった事が原因か？

理想の環境のはずなのに毎日モヤモヤ。精神的な疲労が続く。
今までは事務仕事でお給料を貰っていた。
異動になってからは「こーゆーの作って」を作る事が仕事になった。
ということは、
お金を貰う＝プロ
もしかして、プロになってしまったのか？
えっ、どうしよう。
プロとしてやっていけるほどの技量がないのは分かりきっている。
お給料が少ないのに不満がありつつも、プロとしてお金を貰うのはおこがましい。

なんとかしてプロとしてやっていけるほどの技量をつけなければ、と焦れば焦るほど、いろいろ手を出して何もかも中途半端。
いったいこの先どこに向かっているのだろう。目標が見当たらない。自分がどうなりたいのか分からない。
環境変われどやっぱり迷走。

VBA ユーザーフォームの色をオシャレにする

こんにちは。
派犬事務員のコロ子です。

美的センスに全く自信がありません・・・。

上司：「あのさ、コロ子の作るフォームって、なんかダサいんだよね」

コロ子：「・・・ダサい、と言いますと・・・」

上司：「いつも色とかグレーっぽくてイケてないんだよね」

ええっー！フォームの色って気にするところ！？
ってゆーか、そーゆうものじゃないの？？

上司：「もうちょっとオシャレな感じにならない？」

・・・。
でもよく「人は見かけが9割」とか聞くし（心が痛い）やっぱ見た目って大切なのね・・・。そもそもユーザーフォームの色って変えられるのかな？

ユーザーフォームの色を変える

ユーザーフォームのプロパティを見てみると、色は変更できそう。

でも、選べる色が少ない。
もっといろいろな色を選びたい場合はVBAで色指定できる。

'フォームの背景色を指定
UserForm1.BackColor = RGB(0, 0, 0)

'テキストボックスの背景色を指定
UserForm1.TextBox1.BackColor = RGB(0, 0, 0)
'テキストボックスの文字色を指定
UserForm1.TextBox1.ForeColor = RGB(0, 0, 0)

'コンボボックスの背景色を指定
UserForm1.ComboBox1.BackColor = RGB(0, 0, 0)
'コンボボックスの文字色を指定
UserForm1.ComboBox1.ForeColor = RGB(0, 0, 0)

'コマンドボタンの背景色を指定
UserForm1.CommandButton1 = RGB(0, 0, 0)
'コマンドボタンの文字色を指定
UserForm1.CommandButton1 = RGB(0, 0, 0)

これなら思い通りの色にできるぞ！
と意気込んだところで、そもそもの色のセンスが悪いので配色がおかしい。
やればやるほどダサくなる。
色にも迷走、疲弊したところにこれにたどり着いた。

デザイン本。オシャレな配色のパターンがいっぱい載ってる！
最初からこーゆーの見れば良かったなー。これならオシャレなフォームが作れる！
しかし、世の中そんなに甘くない。いっぱいありすぎて選べない。
フォームにふさわしい配色が分からない。
それでも自分で配色するより100倍マシなので、これと思うものをチョイス。

早速、こんなユーザーフォームで試してみる。

コロ子がチョイスしたのは、カーキ、茶色、オレンジ、黒。
UserForm1.BackColor = RGB(0, 0, 0)
と直接RGB値を指定すると、色々試している間にどの色を指定しているか分からなくなってしまう。思考錯誤用に指定の色のRGB値を戻すモジュールを作成する。

【色モジュール】標準モジュール

Function カーキ() As Long

    Dim R As Long
    Dim G As Long
    Dim B As Long

    R = 237
    G = 186
    B = 98
    
    カーキ = R + G * 256 + B * 256 * 256

End Function

Function オレンジ() As Long

    Dim R As Long
    Dim G As Long
    Dim B As Long

    R = 221
    G = 115
    B = 41
    
    オレンジ = R + G * 256 + B * 256 * 256

End Function

Function 茶色() As Long

    Dim R As Long
    Dim G As Long
    Dim B As Long

    R = 118
    G = 85
    B = 52
    
    茶色 = R + G * 256 + B * 256 * 256

End Function

Function 黒() As Long

    Dim R As Long
    Dim G As Long
    Dim B As Long

    R = 0
    G = 0
    B = 0
    
    黒 = R + G * 256 + B * 256 * 256

End Function

RGB値は
赤の数値 + 緑の数値×256 + 青の数値×256×256
で計算できる。

上記の色を使ってフォームの色を変更する。
【シート1モジュール】

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Load UserForm1

With UserForm1

    With .TextBox1
        .BackColor = 色.黒
        .ForeColor = 色.カーキ
    End With

    With .ComboBox1
        .BackColor = 色.黒
        .ForeColor = 色.カーキ
    End With

    With .CommandButton1
        .BackColor = 色.黒
        .ForeColor = 色.カーキ
    End With

    .BackColor = 色.茶色

    .Show

End With

End Sub

こんな感じになった。

ちょっと良く分からないので、いろいろ作って比較してみよう。

ユーザーフォームをコピーする

①UserForm1を選択して、Ctl+A(全て選択)、Ctr+C(コピー)
②新規にユーザーフォームを挿入してフォーム上でCtr＋V(ペースト)

この方法でもコピーできるけど、フォームのサイズや、各コントロールのマクロはコピーされないので、次の方法がおススメ。

①ユーザーフォームをエクスポートする。
　（フォームの場合はドラッグ＆ドロップはできない。）
・UserForm1.frm
・UserForm1.frx
の2つのファイルが作成される。
　

②元のユーザーフォームの名前を変更する
　UserForm1　→　UserForm2　へ変更
　

③　①で作成したUserForm1.frmをインポートする。

ユーザーフォームを比較する

ユーザーフォームをコピーできたので3っつくらい作って比較してみる。

【シート1モジュール】

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


Load UserForm1

With UserForm1

    With .TextBox1
        .BackColor = 色.黒
        .ForeColor = 色.カーキ
    End With

    With .ComboBox1
        .BackColor = 色.黒
        .ForeColor = 色.カーキ
    End With

    With .CommandButton1
        .BackColor = 色.黒
        .ForeColor = 色.カーキ
    End With

    .BackColor = 色.茶色

    .StartUpPosition = 0
    .Top = 200
    .Left = 100

    .Show vbModeless
    
End With

'******************************************************

Load UserForm2
With UserForm2

    With .TextBox1
        .BackColor = 色.カーキ
        .ForeColor = 色.黒
    End With
      
    With .ComboBox1    
        .BackColor = 色.カーキ
        .ForeColor = 色.黒    
    End With
        
    With .CommandButton1  
        .BackColor = 色.カーキ
        .ForeColor = 色.黒  
    End With

    .BackColor = 色.オレンジ
    
    .StartUpPosition = 0
    .Top = 200
    .Left = 400
    
    .Show vbModeless
    
End With

'******************************************************

Load UserForm3
With UserForm3

    With .TextBox1   
        .BackColor = 色.茶色
        .ForeColor = 色.オレンジ    
    End With    
    
    With .ComboBox1  
        .BackColor = 色.茶色
        .ForeColor = 色.オレンジ    
    End With
        
    With .CommandButton1  
        .BackColor = 色.茶色
        .ForeColor = 色.オレンジ    
    End With

    .BackColor = 色.カーキ
    
    .StartUpPosition = 0
    .Top = 200
    .Left = 700
    
    .Show vbModeless
    
End With

End Sub

ポイント①
3つのフォームを並べて比較したいので、モードレスで表示する。
オブジェクト.Show vbModeless
モードレスにしないと表示されているフォームを閉じないと次のフォームが表示されないので並べて比較できない。

ポイント②
並べて表示させるために、位置指定をする
.StartUpPosition = フォームを最初に表示する時の位置（0は指定なし）
.Top = フォームの上端の位置
.Left = フォームの左端の位置

3つ並べて表示して比較してみる。

えっ！
どれもイマイチですって！！！

やっぱり付け焼き刃じゃダメかぁ～。

おススメのユーザーフォームの配色があったら教えてください！

VBA モジュールを再利用

こんにちは。
派犬事務員のコロ子です。

今更ながら、いつも書いているおなじみの処理の専用モジュールを作れば再利用できる事に気が付いた。本当に今更ながら・・・。

例えば、いつも使う計算式・係数・定数。オリジナルの表記。いろいろあるけど、特に毎回面倒なのがセルの色。
Rangeオブジェクト.Interior.Color がどうしても覚えられない。
Rangeオブジェクト.まで打って何だっけ～、と思いながらインテリセンス表示を2往復くらいして、結局分からなくてネット検索。
更にRGB値も「セルに色を付ける。ホームタブ→塗りつぶしの色→その他の色→ユーザー設定」で毎回調べている。そしてグレートバリアリーフ（GBR）への強い憧れなのか、毎回RGBをGBRと書いてしまう。

セルに色を付ける処理って、そこそこある。
それなのに毎回これって効率悪すぎ！！

それで今更ながらセルの色を付ける専用モジュールを作って保存しておけばいいことに気が付いた。

セルに色を付ける専用モジュールを作る

①標準モジュールに色モジュールを作成する

②色モジュールに、いつも使う色を設定するプロシージャーを作成する。

Sub 黄色(ran As Range)
    ran.Interior.Color = RGB(255, 255, 0)
End Sub

Sub 赤(ran As Range)
    ran.Interior.Color = RGB(255, 0, 0)
End Sub

Sub グレー(ran As Range)
    ran.Interior.Color = RGB(191, 191, 191)
End Sub

Sub ピンク(ran As Range)
    ran.Interior.Color = RGB(255, 153, 255)
End Sub

③モジュールをエクスポートする
色モジュールで右クリックして「ファイルのエクスポート」を選択する。

④色.basファイルとして保存する
C:\Users\***\AppData\Roaming\Microsoft\AddIns　がデフォルトになっているけど、階層が深くて探しに行くのが面倒なので、デスクトップなどにモジュールフォルダを作成して、そこに保存してもいいかも。

色.basファイルができる。

⑤再利用する（モジュールをインポートする）
セルに色を付ける処理が使いたくなったら、色.basファイルをインポートする。
プロジェクトエクスプローラーで右クリックして「ファイルのインポート」を選択する。

もしくはドラッグ＆ドロップでもOK。

【例】A1セルをピンクにする

Call 色.ピンク(Range("A1"))

完成！

あと、既存のセルの色を調べるプロシージャー、調べた色を使うプロシージャー、色を消すプロシージャーとかも便利。

Sub 色調べる(ran As Range)
    Debug.Print ran.Interior.Color
End Sub

Sub 色付ける(ran As Range, myColor As Long)
'myColorには「色調べる」でイミディエイトウインドウに表示された数値を指定する
    ran.Interior.Color = myColor
End Sub

Sub 色消す(ran As Range)
    ran.Interior.Color = xlNone
End Sub

これを作ってからセルに色を付ける処理がサクサクできて楽しくなった。
いろいろなオリジナルモジュールを作ってコレクションすると楽しい。