ドラえもんの道具を一つ貰えるとしたら（真剣に考えてみた）

ドラえもんの道具を貰えるとしたら、を真剣に考えてみた。

欲しい道具は何？

もしドラえもんの秘密道具を一つ手に入れられるとしたら？熱い毎日が続くので、現実逃避してみた。私が欲しいのはずばり、これだ。

ハツメイカー

ハツメイカーは、「ハツメイカーで大発明」（てんとう虫コミックス第30巻に収録）に登場する。

ドラミの出したひみつ道具。これにほしい道具をリクエストすると、その作り方を記した設計図が出てきて、それをもとに組み立てると、ドラえもんのものと同様の道具ができあがる。ドラミ曰く大抵の道具は作れる（どんなリクエストの道具でも完成させられる）とのことで、のび太のように不器用な人間でも道具を作り上げることができる。材料箱と対にして使う。

出典はこちら。
ja.wikipedia.org

まず何を作る？

作中では上記のとおり、何でもそろう「材料箱」とセットで使われている。では、ハツメイカーを貰っても「一つだけ」の条件ゆえに、材料箱を貰えなければ意味がないか。いや、そんなことはない。

例えば、最終製品Ａを作る部品Ｂが現在の科学技術で作れないなら、部品Ｂを作るための装置Ｃを、装置Ｃが存在しなければ、それを作る装置Ｄを「ハツメイ」すればよいのだ。

要素技術をとことんまで突き詰め、分解し、集約して最終製品を作る。これはこれで楽しいじゃないか。

最終的に何を作る？

私が作りたいのは、以下の道具だ。

万能フィルター

この道具の主な機能は、次のとおり。

１．生物以外の全ての物質を、原子レベルで分離・分解可能。

生きている人・動物などを分解できてしまうと、色々な事故や悪用が懸念される。
従って対象は、無生物に限る。
　
　

２．分解した原子を、種類ごとに安全に貯蔵可能。

一か所に大量に貯蔵するとヤバい物質も、この道具なら安全に保管できる。
四次元ポケット的な別空間に保管できれば更に良し。
　
　

３．貯蔵した原子を、指定した組成で合成可能。

有機物・無機物を問わず、様々な物質を合成可能。
しかもその際、副生成物や放射線は一切出ない。
　
　

それで、何をする？

社会貢献度の高い事業を行う。例えば、こんな感じ。
　

① 大気・水質改善

様々な汚染水を、この万能フィルターを通すことで無害な水に変える。河川や海の水質改善で、環境問題解決に寄与する。

また上水道の敷設が不充分な地域に設置し、飲料水を確保することで病気を減らす効果が期待できる。

大気についても同様。

② 土壌改善

汚染土壌から、人体に有害な重金属だけを取り除くなどして、安全な農作物の生産に寄与する。

③ リサイクル

粗大ごみ、不燃物などのリサイクルを行い、環境負荷の軽減に寄与する。電化製品には貴金属が多く含まれており、簡単に回収できれば大きな利益が見込める。
　
　

④ 新素材の開発

貯蔵された素材から、指定した組成で試験片を作成することで、様々な機能性材料の開発に寄与する。組成さえ分れば、新薬を安価で大量に作ることも可能だ。
（麻薬などは作れないようにしておく）。
　

その他

上記以外にも、様々な平和的利用が考えられる。もし実現出来たら、きっと楽しいに違いない。

おわりに

飲み水の改善など、既に商品化されているものも複数ある。これらが夢物語で無くなる日が、きっと来るに違いない（願望）。
　
　
以上、妄想まで。

配列の行または列を切り出し（Index関数)

配列の行または列の切り出しについて、知識があいまいなまま使っていた。
確認してみよう。

Excel VBAにおいて二次元配列の一次元目を行、二次元目を列に準えるとき、
配列のｒ行ｃ列目の値は以下の式で取得できる。

WorksheetFunction.Index(配列, 行番号ｒ, 列番号ｃ)

ここで、例えば行番号に２を指定し、列番号を０とすると、
２行目全体を配列として切り出すことが出来る。

そこで、次のようなテスト用サブプロシージャを作成してみた。

Sub Test1()
    ' 元の配列。
    Dim arr1(2 To 4, 3 To 5) As Variant
    Dim i As Long
    Dim j As Long
    Dim counter As Long: counter = 1
        For i = 0 To 2
            For j = 0 To 2
                arr1(i + 2, j + 3) = Chr(64 + counter)
                counter = counter + 1
        ' なまくらしてみた。普段はやらない書き方。
        Next j, i
        
        ' 元の配列をシートに貼り付け。
        Range("A1").Resize(3, 3) = arr1
    
    ' ２行目を切り出してシートに貼り付け。
    Dim arr2 As Variant
        arr2 = WorksheetFunction.Index(arr1, 2, 0)
        Range("A5").Resize(, 3) = arr2
        
    ' ２列目を切り出してシートに貼り付け。
    Dim arr3 As Variant
        arr3 = WorksheetFunction.Index(arr1, 0, 2)
        Range("E1").Resize(3) = arr3
    
End Sub

結果、以下のことが分かった。

行の切り出しについて

① 一次元配列となる。

② 指定した添え字は、絶対値ではなく相対値。
元々の行の添え字は、２～４。しかし、Index関数で指定した「２」は、添え字の２（つまり１行目）ではなく、２行目を切り出している。

③ 切り出された配列の添え字は、１始まりとなる。

列の切り出しについて

① 二次元配列となる（複数行１列）

② 指定した添え字は、絶対値ではなく相対値。
行の場合と同様のため、省略。

③ 切り出された配列の添え字は、１始まりとなる。
これも、行の場合と同様のため省略。

ついでに、一次元配列から一次元配列を切り出したらどうなるか、確認してみた。

Sub Test2()
    Dim arr1(2 To 4)
        arr1(2) = 1
        arr1(3) = 2
        arr1(4) = 3
        
    Dim arr2 As Variant
        arr2 = WorksheetFunction.Index(arr1, 1, 0)
        
    Dim arr3 As Variant
        arr3 = WorksheetFunction.Index(arr1, 0, 2)
End Sub

結果、以下のことが分かった。

1. 一次元から一次元を切り出すことは可能。
   ただし、添え字は１始まりに矯正される。
2. 元がIntegerやLong型の数値であっても、切り出すとDouble型になる。
3. 列で切り出した場合、要素が一つの配列となる。

今回は、色々と整理できて有意義だった。

ただし上記の結論は
「特殊解としてそのように見えるだけで、一般解ではない」
恐れもあるので、間違っていたら直ぐ訂正します。

参考まで。

配列の行列入れ替え（Transpose関数）

配列の行列入れ替えについて、知識が曖昧なまま使っていた。
確認してみよう。

ワークシートでは、コピーしたものの行と列を入れ替えて貼り付けが出来る。

これをマクロの記録で見てみると、こうだ。

Sub Macro1()
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

この中で重要なのは、この部分。これが、行列を入れ替えさせている。

Transpose:=True

では、一次元の配列をマクロでひっくり返す場合はどうか。今回は、
二回ひっくり返してみる。

Sub Test()
    ' 元の配列。
    ' indexがどう変化するかを確認するため、
    ' 敢えてインデックスを３～４としている。
    Dim arr1(3 To 4) As Variant
        arr1(3) = 1
        arr1(4) = 2
    
    ' ひっくり返し、一回目。
    Dim arr2 As Variant
        arr2 = WorksheetFunction.Transpose(arr1)
    
    ' ひっくり返し、二回目。
    Dim arr3 As Variant
        arr3 = WorksheetFunction.Transpose(arr2)
End Sub

すると、以下のことが分かった。

• １回目　２行１列の二次元配列に変換
• ２回目　再び一次元配列に。ただし、インデックスが１始まりに

では、２行１列の二次元配列を二回ひっくり返したらどうか。

Sub Test2()
    ' 元の配列。
    ' indexがどう変化するかを確認するため、
    ' 今回も中途半端なところからインデックスを開始。
    Dim arr1(3 To 4, 2 To 2) As Variant
        arr1(3, 2) = 1
        arr1(4, 2) = 2
    
    ' ひっくり返し、一回目。
    Dim arr2 As Variant
        arr2 = WorksheetFunction.Transpose(arr1)
    
    ' ひっくり返し、二回目。
    Dim arr3 As Variant
        arr3 = WorksheetFunction.Transpose(arr2)
End Sub

結果は、以下のとおり。

• １回目　インデックスが１始まりの一次元配列に
• ２回目　再び二次元配列に。ただし、インデックスが１始まりに

最後に、１行２列の二次元配列ではどうか。

Sub Test3()
    ' 元の配列。
    Dim arr1(3 To 3, 2 To 3) As Variant
        arr1(3, 2) = 1
        arr1(3, 3) = 2
    
    ' ひっくり返し、一回目。
    Dim arr2 As Variant
        arr2 = WorksheetFunction.Transpose(arr1)
    
    ' ひっくり返し、二回目。
    Dim arr3 As Variant
        arr3 = WorksheetFunction.Transpose(arr2)
End Sub

結果は、以下のとおり。

• １回目　２行１列の二次元配列に
• ２回目　一次元配列に。二次元配列には戻らない。

インデックスが１始まりに矯正されることについては、使用状況によって良し悪しあるかも。
（個人的には、この方が都合の良い場面が多い気がします）。

参考まで。

不連続な範囲を選択（失敗談）

不連続な範囲を、お手軽に選択したくなった。

例えば、Ａ１とＣ３を選択したい場合。

その場合、このような書き方が可能だ。

ちなみに、↓ こう書くと、

Range("A1","C3").Select

これは選択範囲の左上と右下を指しており、この間の全セルが選択されてしまう。

ところで、先程の ↓ この書き方、限界はあるのだろうか。

Range("A1,C3").Select

そこで、Ａ列のセルを一つずつ選択して、どこが限界か試してみた。

Range("A1,A2").Select
Range("A1,A2,A3").Select
Range("A1,A2,A3,A4").Select

手作業で一つずつ試すのは大変なので、実際はテスト用サブプロシージャを作成。

Sub test()
    ' 座標格納のための配列。
    Dim arr As Variant
        arr = Array()
        
    ' 上記配列を用いて、不連続な範囲をセットするための
    ' Rangeオブジェクト。
    Dim myRng As Range
    Dim i As Long: i = 1
        
        On Error Resume Next
        Do While Err.Number = 0
            ReDim Preserve arr(UBound(arr) + 1)
            arr(UBound(arr)) = "A" & i
            
            Set myRng = Range(Join(arr, ","))
                myRng.Select
                i = i + 1
        Loop
End Sub

すると、割と早めに限界が訪れた。

そうか、そこが限界なのか。ならば、二つずつの場合はどうか。

arr(UBound(arr)) = "A" & i & ":A" & i + 1

66×2=132で、A132まで選択されるのかな？と思っていた。
しかし結果は、同じだった。

では、三つずつの場合は？

今度は増えた。？？？。そして気づいた。選択できるセルの数に限界があるのではなく、↓ の〇〇〇に許される文字数が限界だったってことに。

Range(〇〇〇)

その後試した限り、255文字が上限らしい。以後、気を付けます。

参考まで。

「追加したはずの右クリックメニューが表示されない事件」の真相 ⑥

先日来、２年越しの事件が解決しそうだ。
infoment.hatenablog.com

今日は、今回のシリーズのまとめ、最終回。

今回新調した、右クリックメニュー追加用クラスモジュール。
自宅で試して限り上手く行ったのに、職場では期待通りの動作に
ならなかった。どうして？

色々調べて分かったこと。それは、Excelのバージョンによって、
例えば同じ「List Range Popup」でも、Indexが異なるということ。
番号で指定していたため、完全に見当違いのところに追加していた
わけで。

ということで、各定数を番号ではなく名前に置き換えることにした。
これなら、番号のずれがあっても対応できると考えたからだ。

【変更前】

    Const cb標準_Range As Long = 38
    Const cb改プ_Range As Long = 41
    Const cb標準_PivotTable As Long = 61
    Const cb標準_ListObject As Long = 74
    Const cb改プ_ListObject As Long = 75

【変更後】

    Const cb標準_Range As String = "Cell"
    Const cb改プ_Range As String = "Cell"
    Const cb標準_PivotTable As String = "PivotTable Context Menu"
    Const cb標準_ListObject As String = "List Range Popup"
    Const cb改プ_ListObject As String = "List Range Layout Popup"

　
最終的な成果物がこちら。

クラスモジュール（RightClickComman）

Option Explicit

    ' 「改プ」は改ページプレビューの意
    Const cb標準_Range As String = "Cell"
    Const cb改プ_Range As String = "Cell"
    Const cb標準_PivotTable As String = "PivotTable Context Menu"
    Const cb標準_ListObject As String = "List Range Popup"
    Const cb改プ_ListObject As String = "List Range Layout Popup"
    
    Dim TargetArray As Variant
    Dim LoopIndex As Variant
    Dim i As Long

Private Property Get DefaultArray() As Variant
    ' 右クリックメニューを設定するCommandBarの
    ' インデックスを集めた配列。
    Dim arr As Variant
        arr = Array()
        For i = 1 To Application.CommandBars.Count
            Select Case Application.CommandBars(i).Name
                Case cb標準_Range, _
                     cb改プ_Range, _
                     cb標準_PivotTable, _
                     cb標準_ListObject, _
                     cb改プ_ListObject
                    
                    ReDim Preserve arr(UBound(arr) + 1)
                    arr(UBound(arr)) = i
            End Select
        Next
            
        DefaultArray = arr
        
End Property

Private Sub Class_Initialize()
    ' メニューを追加するCommandBarの初期設定。
    ' ※上書きで任意に変更可。
    TargetArray = DefaultArray
End Sub

' 追加予定のメニュー名存在確認。
Private Function DuplicateFlag(name_to_add As String, _
                               commandbar_index As Long) As Boolean
    
    ' 追加予定の名前が存在する場合、Trueを返す。
    With Application.CommandBars(commandbar_index)
        For i = .Controls.Count To 1 Step -1
            If .Controls.Item(i).Caption = name_to_add Then
                DuplicateFlag = True
                Exit Function
            End If
        Next
    End With
    
End Function

' 指定CommandBarへ指定メニュー追加。
Public Sub AddMenuToSpecifiedCommandBar(name_to_add As String, _
                                        action_to_add As String, _
                                        commandbar_index As Long, _
                               Optional begin_group As Boolean = False)
            
    ' 追加予定のメニューが無い場合に限り、追加処理を行う。
    ' ※同名の右クリックメニューが存在する場合、既存優先とする。
    If Not DuplicateFlag(name_to_add, commandbar_index) Then
        With Application.CommandBars(commandbar_index).Controls.Add
            .Caption = name_to_add
            .OnAction = action_to_add
            .BeginGroup = begin_group
        End With
    End If
    
End Sub

' 各CommandBarへ指定メニュー追加。
Public Sub AddMenu(name_to_add As String, _
                   action_to_add As String, _
          Optional begin_group As Boolean = False)

    
    For Each LoopIndex In TargetArray
        AddMenuToSpecifiedCommandBar name_to_add, _
                                     action_to_add, _
                                     CLng(LoopIndex), _
                                     begin_group
    Next
    
End Sub

' 指定CommandBarから指定メニュー削除。
Public Sub DelMenuFromSpecifiedCommandBar(name_to_del As String, _
                                          commandbar_index As Long)
        
    ' 指定メニューが存在する場合のみ、それを削除する。
    ' ※既存の標準メニューも消せるため注意。
    ' ※DuplicateFlagのiを、そのまま削除に用いる。
    If DuplicateFlag(name_to_del, commandbar_index) Then
        Application.CommandBars(commandbar_index).Controls.Item(i).Delete
    End If
    
End Sub

' 各CommandBarから指定メニュー削除。
Public Sub DelMenu(name_to_del As String)

    For Each LoopIndex In TargetArray
        DelMenuFromSpecifiedCommandBar name_to_del, CLng(LoopIndex)
    Next
    
End Sub

' リセット。
Public Sub ResetMenu()

    For Each LoopIndex In TargetArray
        Application.CommandBars(LoopIndex).Reset
    Next
    
End Sub

今までは問い合わせに対し、
「改ページプレビューでは、なぜか表示されないんです」
と回答していた。

明日からは、問い合わせの数が減ってくれそうです。
ということで、このシリーズはこれでおしまい。

参考まで。

「追加したはずの右クリックメニューが表示されない事件」の真相 ⑤

先日来、２年越しの事件が解決しそうだ。
infoment.hatenablog.com

先日は、追加しようとする右クリックメニューが追加済みでない場合に限り、追加を実行するところまで作成した。

今日は、前回の続きから。

用が済めば、後片付けが必要だ。
そこで、右クリックメニューを削除する方法として、以下の二つを準備してみた。

• 指定した右クリックメニューを削除
• 一括リセット

実際に作成したのが、こちら。

クラスモジュールの一部（RightClickCommand）

今回は、抜粋で掲載。コードの全文は最終回にまとめて掲載としよう。

↓削除する場合。

' 指定CommandBarから指定メニュー削除。
Public Sub DelMenuFromSpecifiedCommandBar(name_to_del As String, _
                                          commandbar_index As Long)
        
    ' 指定メニューが存在する場合のみ、それを削除する。
    ' ※既存の標準メニューも消せるため注意。
    ' ※DuplicateFlagのiを、そのまま削除に用いる。
    If DuplicateFlag(name_to_del, commandbar_index) Then
        Application.CommandBars(commandbar_index).Controls.Item(i).Delete
    End If
    
End Sub

' 各CommandBarから指定メニュー削除。
Public Sub DelMenu(name_to_del As String)

    For Each LoopIndex In TargetArray
        DelMenuFromSpecifiedCommandBar name_to_del, CLng(LoopIndex)
    Next
    
End Sub

↓リセットする場合。

' リセット。
Public Sub ResetMenu()

    For Each LoopIndex In TargetArray
        Application.CommandBars(LoopIndex).Reset
    Next
    
End Sub

リセットする方が、断然スッキリしている。
ただし、消してはいけないものがあったとしても全て消えてしまうので、要注意。

標準モジュール

使用例がこちら。

' 個別削除の場合。
Sub Test_Delete()
    With New RightClickCommand
        .DelMenu "ホゲ"
        .DelMenu "ホげ"
        .DelMenu "ほげ"
    End With
End Sub

' 一括リセットの場合。
Sub Test_Reset()
    With New RightClickCommand
        .ResetMenu
    End With
End Sub

これで、準備は整った。後は、実際の業務で使ってみるだけだ。

ところが実際に使ってみると・・・ん？何かがおかしい。
そう、既にお気づきの方も居られると思うが、このクラスモジュールには、単純で重大な欠陥があったのだ。

ということで次回、最終回に続きます。

参考まで。

「追加したはずの右クリックメニューが表示されない事件」の真相 ④

先日来、２年越しの事件が解決しそうだ。
infoment.hatenablog.com

今日は前日までの内容のうち、メニュー追加までを纏めてみる。

何とかの一つ覚え、今回もクラスモジュールにまとめてみた。

クラスモジュール（RightClickCommand）

今回の作戦は、こんな感じだ。

1. 各コマンドバーの番号は、数字だけでは判別しえないので定数にしておく。
2. 上記定数を「初期設定配列」に格納し、ユーザーが毎回していしなくとも、
   大体使いそうなコマンドバーに一括設定できるようにする
   （ただし任意に上書き可能）。
3. 同じコマンドが幾つも追加されないよう、有無確認関数を作成。
4. 個別のコマンドバーに追加する機能を準備し、各コマンドバーのループから
   取り出すことで個別設定も可能とする。

以上を踏まえて作成したのが、こちら。

Option Explicit

' 「改プ」は改ページプレビューの意
Const cb標準_Range As Long = 38
Const cb改プ_Range As Long = 41
Const cb標準_PivotTable As Long = 61
Const cb標準_ListObject As Long = 74
Const cb改プ_ListObject As Long = 75

Public TargetArray As Variant
Dim LoopIndex As Variant
Dim i As Long

Private Property Get DefaultArray() As Variant
    ' 右クリックメニューを設定するCommandBarの
    ' インデックスを集めた配列。
    Dim arr As Variant
        arr = Array(cb標準_Range, _
                    cb改プ_Range, _
                    cb標準_PivotTable, _
                    cb標準_ListObject, _
                    cb改プ_ListObject)
        DefaultArray = arr
End Property

Private Sub Class_Initialize()
    ' メニューを追加するCommandBarの初期設定。
    ' ※上書きで任意に変更可。
    TargetArray = DefaultArray
End Sub

' 追加予定のメニュー名存在確認。
Private Function DuplicateFlag(name_to_add As String, _
                               commandbar_index As Long) As Boolean
    
    ' 追加予定の名前が存在する場合、Trueを返す。
    With Application.CommandBars(commandbar_index)
        For i = .Controls.Count To 1 Step -1
            If .Controls.Item(i).Caption = name_to_add Then
                DuplicateFlag = True
                Exit Function
            End If
        Next
    End With
    
End Function

' 指定CommandBarへ指定メニュー追加。
Public Sub AddMenuToSpecifiedCommandBar(name_to_add As String, _
                                        action_to_add As String, _
                                        commandbar_index As Long)
            
    ' 追加予定のメニューが無い場合に限り、追加処理を行う。
    ' ※同名の右クリックメニューが存在する場合、既存優先とする。
    If Not DuplicateFlag(name_to_add, commandbar_index) Then
        With Application.CommandBars(commandbar_index).Controls.Add
            .Caption = name_to_add
            .OnAction = action_to_add
        End With
    End If
    
End Sub

' 各CommandBarへ指定メニュー追加。
Public Sub AddMenu(name_to_add As String, _
                   action_to_add As String)
    
    For Each LoopIndex In TargetArray
        AddMenuToSpecifiedCommandBar name_to_add, _
                                     action_to_add, _
                                     CLng(LoopIndex)
    Next
    
End Sub

標準モジュール

それでは、早速テストしてみよう。
右クリックメニューに追加するのは、こちらのサブプロシージャ。

Sub Hoge()
    MsgBox "ほげ"
End Sub

これを、個別に追加してみる。

Sub Test()
    With New RightClickCommand
        .AddMenuToSpecifiedCommandBar "ホゲ", "Hoge", 38
        .AddMenuToSpecifiedCommandBar "ホげ", "Hoge", 74
        .AddMenuToSpecifiedCommandBar "ほげ", "Hoge", 61
    End With
End Sub

結果、それぞれ別の右クリックメニューに追加することが出来た。

また、↓ こちらの場合は、複数を追加することができた。

Sub Test2()
    With New RightClickCommand
        .AddMenu "ホゲ", "Hoge"
        .AddMenu "ホげ", "Hoge"
        .AddMenu "ほげ", "Hoge"
    End With
End Sub

これで、半分が出来た。

次回は、もう半分（消す方）に挑戦です。

参考まで。