コマンドバーの作り方

2024年12月17日 06:59

先日、購入者のかたから質問がありました。
トレード記録や検証記録のデータの加工についてのご質問でした。

例えばトレード記録や検証記録があるとして、これを並べ替えて資産曲線の形状の変化から、期待値のあるトレードを検証しようとするとします。

この点に関しては下記の記事をご覧ください。

このようにデータをいじるときは、原本は触らないということです。
代わりに、右隣に同じデータを貼り付けます。
このデータで検証します。

この際かなりのコマンドボタンが必要になります。これらをシート上に貼り付けるのもよいですが、コマンドボタンが多くなりすぎると、シートが見にくくなります。
そこでExcelフォーム上にコマンドボタンを配置したコマンドバーを作っています。

以下が検証シートで私が使っているコマンドバーです。黒塗りが多いところは見られたくないコマンドです。現在全部で44個配置しています。拡張ボタンを押すと、3段目のボタンが現れます。

次に、シート原本を【結果】とし、CTRL＋ドラッグで同じシートを複数個作ります。

以下が、コマンドバーに配置した基本的なコマンドのコードです。

■右にボタン
現在シートの右にデータ部分のみ転写します。（項目がA列からAN列まである場合）
このボタンで同じデータが右や、右右、左に転写されます。

Private Sub 右に_Click()
Range("A:AN").Copy ActiveSheet.Next.Range("A1")
Application.CutCopyMode = False
End Sub

Private Sub 右右_Click()
Range("A:AN").Copy ActiveSheet.Next.Next.Range("A1")
Application.CutCopyMode = False
End Sub

Private Sub 左に_Click()
Range("A:AN").Copy ActiveSheet.Previous.Range("A1")
Application.CutCopyMode = False
End Sub

■カットボタン
選択行から下のデータをカットします。また色を付けたりしているので、色もクリアにします。
これが、以前の記事でぶった切ると表現した部分です。

Private Sub カット_Click()
r = ActiveCell.Row
endr = Cells(Rows.Count, 1).End(xlUp).Row
Range("A" & r & ":AN" & endr).ClearContents
Range("A" & r & ":AN" & endr).Interior.Pattern = xlNone
End Sub

■クリアボタン
2行目から最下行までをクリアにします。
If endr = 1 Then endr = 2　
はデータがないときに1行目の項目名までクリアされることを回避するコードです。

Private Sub クリア_Click()
endr = Cells(Rows.Count, 1).End(xlUp).Row
If endr = 1 Then endr = 2
Range("A2:AN" & endr).ClearContents
Range("A:AN").Interior.Pattern = xlNone
End Sub

■コピーボタン
2行目から最終行までをコピーします。

Private Sub コピー_Click()
endr = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:AN" & endr).Copy
End Sub

■↑並び　↓並びボタン
日付け順に、昇順や降順で並べ替え、資産曲線もセットされます。
このコードはA列に日付け、H列に損益、BA列が資産累計となってることを前提としています。

Private Sub 並↑_Click()
Application.ScreenUpdating = False
endr = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:AN" & endr).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes

Columns("BA").ClearContents
Range("BA2:BA" & endr).Formula = "=BA1+H2"
    ActiveSheet.ChartObjects(ActiveSheet.ChartObjects(1).Name).Activate
    ActiveChart.SeriesCollection(1).Formula = "=SERIES(,,'" & ActiveSheet.Name & "'!$BA$2:$BA$" & endr & ",1)"
Range("A1").Select
End Sub


Private Sub 並↓_Click()
Application.ScreenUpdating = False
endr = Cells(Rows.Count, 1).End(xlUp).Row
　　Range("A1:AN" & endr).Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes

Columns("BA").ClearContents
Range("BA2:BA" & endr).Formula = "=BA1+H2"
    ActiveSheet.ChartObjects(ActiveSheet.ChartObjects(1).Name).Activate
    ActiveChart.SeriesCollection(1).Formula = "=SERIES(,,'" & ActiveSheet.Name & "'!$BA$2:$BA$" & endr & ",1)"
Range("A1").Select
End Sub

■列広、列狭
私の場合検証シートのデータ部分ではA 列からAZ列までの52列を使っています。通常は視認性のため重要度の低い項目は幅を小さくしていますが、項目全体を見たいときは列広ボタンを押して列幅を広げています。
列狭ボタンで元の列幅に戻ります。
このコードは長くなるので、標準モジュールを別途作り記述しています。

Private Sub 列幅狭_Click()
    Call 列幅調整狭
End Sub
Private Sub 列幅広_Click()
    Call 列幅調整広
End Sub

Sub 列幅調整狭()
Application.ScreenUpdating = False
Columns(1).ColumnWidth = 10.5
Columns(2).ColumnWidth = 2
Columns(3).ColumnWidth = 1
Columns(4).ColumnWidth = 12
Columns(5).ColumnWidth = 6
Columns(6).ColumnWidth = 6

行数が長くなるのでコードを省略しています。

■ジャンプ
並べ替えをしたときに、ジャンプしたいときに使います。
このコードは、数値を入れれば、その行にジャンプします。
日付けを入れれば、その日付けにジャンプします。
日付けは、12/10などの場合、今年ということになります。昨年にジャンプしたいときは23/12/10などと入れます。

Private Sub ジャンプ_Click()
Dim FC As Range
    endr = Cells(Rows.Count, 2).End(xlUp).Row
    r = InputBox("", "ジャンプ")
    If IsDate(r) = True Then
            Set FC = Columns("A").Find(What:=DateValue(r))
            If FC Is Nothing Then
                    MsgBox r & " 対象日無し"
            Else
                    FC.Select
            End If
    Else
            Range("A" & r).Select
    End If
    Beep
End Sub

私は、かなりの数の検証を行っているので、このようなコマンドバーを作って検証時間を短縮しています。

スキやフォロー、コメントを頂けるとモチベが上がります。よろしくお願いいたします。

コマンドバーの作り方

いいなと思ったら応援しよう！