2022-07-03

VBA100本ノック 34本目：配列の左右回転

Excel VBA 100本ノック

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

これは面白い問題。今回は、このように考えた。

左右の向きに関わらず、３回回すと元に戻る。
左に３回は、右に１回と同じ。

ということで、まず右に（時計回りに）１回回すのがこちら。

' 配列を右に回転させる関数。
Function RotationToRight(ByVal source_array As Variant) As Variant
    ' 回転後の配列を格納するための配列。
    ' 配列を１始まりに矯正している。
    Dim arr() As Variant
    ReDim arr(1 To UBound(source_array, 2) - LBound(source_array, 2) + 1, _
              1 To UBound(source_array, 1) - LBound(source_array, 1) + 1)
    Dim i As Long
    Dim j As Long
    
    ' 回転。
        For i = 1 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                arr(i, j) = source_array(j + LBound(source_array) - 1, _
                                         UBound(source_array, 2) + 1 - i)
            Next
        Next
        
        RotationToRight = arr
End Function

次いで、「左右のどちらか」「回転する回数」を指定して回転する関数がこちら。

Function RotateArray(source_array As Variant, _
            Optional rotation_direction As XlDirection = xlToRight, _
            Optional rotation_times As Long = 1) As Variant
    ' 右に一回転を初期設定とする。
    ' ４回転で１周するので、まず４回以上の指定回数を１～４に変換する。
    Dim RotationTimes As Long
        RotationTimes = rotation_times - 1 Mod 4 + 1
    
    ' 右以外が指定された場合は左回転と見做し、右回転に換算する。
    ' 例えば左へ３回転は、右へ１回転と同じ。
        If rotation_direction <> xlToRight Then
            RotationTimes = 4 - RotationTimes
        End If
    
    Dim arr() As Variant
    ReDim arr(1 To UBound(source_array, 1) - LBound(source_array, 1) + 1, _
              1 To UBound(source_array, 2) - LBound(source_array, 2) + 1)
    Dim i As Long
    Dim j As Long
    
        For i = 1 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                arr(i, j) = source_array(i - 1 + LBound(source_array, 1), _
                                         j - 1 + LBound(source_array, 2))
        Next j, i
        
        Select Case RotationTimes
            Case 1 To 3
                For i = 1 To RotationTimes
                    arr = RotationToRight(arr)
                Next
        End Select
        
        RotateArray = arr
End Function

それでは、↓ こちらで検証してみよう。

Sub VBA_100Knock_034()
    Dim arr As Variant
        arr = Range("A1:D3")
        
        ' 右に90度。
        Range("A6:C9") = RotateArray(arr)

        ' 左に90度。
        Range("A12:C15") = RotateArray(arr, xlToLeft)
End Sub

↓ 結果がこちら。

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。

2022-07-02

VBA100本ノック 33本目：マクロ記録の改修

Excel VBA 100本ノック

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

自分もマクロを覚えたての頃は、全コードに占めるマクロの記録が７～８割を
越えることなんてザラだった。だから今でも、「マクロを見て欲しい」と言わ
れこのようなコードをお見掛けしても、決して否定はしない。多くの人が辿る
道なのだから（賛否両論あり）。

また、このような「撮りたて生コード」をどう調理するかは、その方の習熟度
を測る指標にもなると思う。

ということで、今の私はこんな感じだ。

Sub VBA_100Knock_033()
    Dim Sh As Worksheet
    Set Sh = Sheets("データ")
    
    Dim rMax As Long
        rMax = Sh.Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim TargetRange As Range
    Set TargetRange = Range(Sh.Cells(2, 1), Sh.Cells(rMax, 1)).Resize(, 6)
    
        Application.ScreenUpdating = False
    
        TargetRange.Columns(4) = "=IFERROR(VLOOKUP(RC[-2],マスタ!C[-3]:C[-1],2,FALSE),"""")"
        TargetRange.Columns(5) = "=IFERROR(VLOOKUP(RC[-3],マスタ!C[-4]:C[-2],3,FALSE),"""")"
        TargetRange.Columns(6) = "=RC[-1]*RC[-3]"
    
    ' VLOOKUPの計算結果を値に変更。
        Sh.UsedRange.Value = Sh.UsedRange.Value

        Application.ScreenUpdating = True

        Range("A1").Select
End Sub

ということで、原文よりも行数が増えてしまった。今はこれが精一杯。
※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。

2022-06-21

久しぶりの「三角関数の合成」

高校数学雑感

先日、長男（高２）の数学で、久しぶりに「三角関数の合成」と再会した。
懐かしさのあまり、復習してみた。
$asinθ+bcosθ=\sqrt{a^2+b^2}sin(θ+α)$
ただし $角度α$ は、下図でいえばｘ軸と線分ACの成す角度とする。

この円の半径 $ｒ$ は、三平方の定理から次のように求まる。
$r=\sqrt{a^2+b^2}$
また、三角比の定義によりａ，ｂはそれぞれ以下のとおり。
$a=rcosα$
$b=rsinα$
ゆえに最初の式に戻ると、加法定理により
$asinθ+bcosθ=r(sinθcosα+cosθsinα)=\sqrt{a^2+b^2}sin(θ+α)$
となる。

教科書ではその後に、このような練習問題が。
$\sqrt{3}sinθ+cosθ$
これは、
$cosα=\dfrac{a}{\sqrt{a^2+b^2}}=\dfrac{\sqrt{3}}{\sqrt{\sqrt{3}^2+1^2}}=\dfrac{\sqrt{3}}{2}$
であるから、
$α=\dfrac{π}{6}$
となって、答えは
$2sin(θ+\dfrac{π}{6})$
となる。実際グラフを描いてみれば、両者はピッタリと一致する。

この問題の $α(=\dfrac{π}{6})$ を見て、思った。誤解を恐れずに言うならば、当時はあまり
感じなかったが高校生の時って、とても丁寧に導かれてたんだなって。

参考まで。

2022-06-20

VBA100本ノック 32本目：Excel終了とテキストファイル出力

Excel VBA 100本ノック

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

ファイル操作などを行う際、DirとFileSystemObjectのどちらを使用すべきか？
が話題にあがるように思う。個人的にはFileSystemObjectの方が好みだ。先日
新たに知ったのだが、

FSO.BuildPath(A, B)

とすると、Aの末尾に「\」があってもなくても、良い感じにＡとＢを繋いで
くれる。これは便利だ。

また、テキストファイルへの書き出しは偶にしか行わないので、いつもうろ
覚えだったりする。今回は、良い復習の機会になった。

Sub VBA_100Knock_032()
    ' Microsoft Scripting Runtimeを参照済み。
    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject
    
    ' ログ用ファイルの作成と
    Dim LogPath As String
        LogPath = FSO.BuildPath(ThisWorkbook.Path, Format(Now, "yyyymmddhhmmss.txt"))
        FSO.CreateTextFile LogPath
        Open LogPath For Output As #1
    
    ' 起動中のブックについて、パスをログファイルに書き出したうえで上書き保存。
    Dim Wb As Workbook
        For Each Wb In Workbooks
            If Wb.Name <> ThisWorkbook.Name Then
                Print #1, Wb.FullName
                Wb.Close SaveChanges:=True
            End If
        Next
    
    ' マクロブックのパスの書出しと終了。
        Print #1, ThisWorkbook.FullName
        Close #1
        
        ThisWorkbook.Close SaveChanges:=True
    
    ' Excelの終了。
        Application.Quit
End Sub

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。

2022-06-12

VLOOKUP関数で「0」を表示しない３つの方法

Excel

VLOOKUP関数で検索先が空欄の場合、数字の「0」が返ってしまう。

そこで、「0」を表示しない方法を以下にまとめてみた。

1. ゼロ値のセルにゼロを表示する

「ファイル」「オプション」の「詳細設定」に、
・ゼロ値のセルにゼロを表示する
というオプションがある。

このチェックを外すことで、0を表示させなくできる。

この指定はシート単位で行われるため、意図しない範囲の0まで消えて
しまうこともある（要注意）。

2. 無理矢理文字にする

VLOOKUP関数の先頭に""を追加することで、結果を文字にする。

数字だと「何もない＝０」だが、文字にしてしまえば０にならない。

3. ユーザー定義書式で0を非表示にする

セルの書式設定で、ユーザー定義書式を設定することができる。
方々で解説されている通り、「；」で各書式を個別に設定可能だ。

正の数の書式；負の数の書式；ゼロの書式；文字列の書式

従って文字のみ表示したい場合、以下のように設定する。

;;;@

まとめ

以上1. ～3. をご紹介したが、きっと他にも良い方法があるに違いない。
どの方式を採用するかは各位の、時と場合とお好みで。

参考まで。

2022-06-06

VBA100本ノック 31本目：入力規則

Excel VBA 100本ノック

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

作成したマクロがこちら。

Sub VBA_100Knock_031()
    ' シート名リスト作成用配列。
    Dim SourceList() As Variant
    ReDim SourceList(1 To Sheets.Count)
    Dim i As Long
        For i = 1 To Sheets.Count
            SourceList(i) = Sheets(i).Name
        Next    
    
    With Range("A1").Validation
        ' 既存の入力規則を削除。
        .Delete
        ' 入力規則追加。
        .Add Type:=xlValidateList, _
             AlertStyle:=xlValidAlertStop, _
             Formula1:=Join(SourceList, ",")
        ' ドロップダウンで選択。
        .InCellDropdown = True
        ' エラー時のメッセージタイトル。
        .ErrorTitle = "入力不可"
        ' エラー時のメッセージ。
        .ErrorMessage = "こちらは選択専用セルです。"
        ' エラーの表示許可。
        .ShowError = True
    End With
End Sub

ドロップダウンを設定したことは、今までに何度かあった。しかし

.InCellDropdown = True

など、細かいプロパティについてあまり気にしたことがなかったので、
今回は良い勉強になった。

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。

2022-06-03

久しぶりの等加速度直線運動

Excel VBA 100本ノック

先日、長男（高２）の物理で、久しぶりに等加速度直線運動と再会した。
懐かしさのあまり、復習してみた。

ボールを地表から真上に、以下の条件で打ち上げたとする。
初　速： $29.4 m/s$
重力加速度： $9.8 m/s^2$
このとき、ｔ秒後の物体の速度は？という問題。

懐かしい、基本中の基本である。
しかしこれも、馴染みない方は難問と感じるかもしれない。そんなときは問題を
こう読み替えると良いかも。

Ａさんが、ある施設を利用する。
所持金： $29.4円$
利用料： $１時間あたり9.8円$
このとき、ｔ時間後のＡさんの所持金はいくらか？

答えは、まったく同じ数字になる（勿論、本質や単位等は違うが）。

これを数式にしてグラフに表すと、単純明快な問題であることが分かる。

ｔ秒後の速度を求める式は、中学二年で習う一次関数 $y=ax+b$ で表される。
$v=-9.8t+29.4$
初速は切片 $(b)$ であり、加速度は傾き $(a)$ という訳だ。3秒後には速度0となって
ボールは最高到達点に達し、今度は地面に向かって落ちてくる。上向きの速度を
＋で考えるなら、下向きの速度は－となる。

小学生の時、距離と速度と時間の関係を習った。
$距離＝速度×時間$
このグラフを見ると、横軸が時間で縦軸が速度であるから、面積が距離となる。

上記台形の面積の求め方は、小学校の時習った。
$面積=(上底+下底)×高さ÷2$
$=(29.4-9.8t+29.8)×t÷2=-4.9t^2+29.8t$
これは中学三年生で習う、上に凸な放物線だ。

縦軸が距離だから、この放物線はｔ秒後のボールの地面からの高さを示している。
この場合は３秒後に44.1ｍまで届き、6秒後に地面に落ちることがわかる。