コピペで使えるVBA

＊コード・記事本文は全て無料です
＊金額設定は、記事内容に対してサポートを求める人向けです

なんだかんだVBA（VBS）って触る機会が多いですよね。

規模の大きいモノであれば、ふるくさ～いエディタが嫌でVSCodeと連携させたり色々するものです。
でも、私の場合は、エクセル上でのちょっとした自動化とかちょちょいと頼まれる転記・集計の自動化の時にはVBAをそのまま触ったりします。

そんなこんなで、VBAを触っていて使いまわしたコード部品をちょこちょこっと書き直して置いておきます。

- 社内とかでちまちまマクロを編集している方
- 作成したものを利用するユーザーがリテラシーの低い他者である
- 自分が抜けた後、上記の人達が中身をコピペで検索してそれっぽいものが見つかる書き方を目指している

人向け……に、なっているはずです。

定義が雑だったりするので、その辺はエラーで弾かれたら「こいつは～！」っ思うに留めて頂けると幸いです。

変換辞書登録したもの達

矢印の変換はGoogle変換使用慣れです。
Google変換非対応環境を強いられる場合、必ず登録している辞書なので、VBAとか関係ないけど紹介します。

（多分）どこでも使える

1.画面チカチカさせない・バックグラウンドで処理をさせる

画面を変更させないようにしてカーソルもぐるぐる回します。

触ってエクセルフリーズさせたり、作成当初から使っていく内に該当ファイルや読み込むファイルが膨大に膨れあがって動かなくなるなんてこと無いようにします。

'# 始めに付ける
   With Application
        .Cursor = xlWait
       .Calculation = xlCalculationManual
       .DisplayAlerts = False
       .EnableEvents = False
       .ScreenUpdating = False
   End With

'# ～ここにマクロを記述する～

'# 終に付ける
   With Application
       .Cursor = xlDefault
       .Calculation = xlCalculationAutomatic
       .DisplayAlerts = True
       .EnableEvents = True
       .ScreenUpdating = True
   End With

始めの中でシートの自動計算を停止している為、シートの計算を加味してなんかやってる方は、該当箇所の直前で「xlCalculationAutomatic」に戻して、それで重くなったら通過後にまた手動「xlCalculationManual」に戻すとかすると良いと思います。

2.ファイル・フォルダを開く

私はFileDialogを使っていますが、なんでGetOpenFilenameじゃなくてFileDialogにしたのかを覚えていません……。また改めて自分にはどちらが良いのかを考え直そうと思いました。

ファイル

Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
   If .Show = -1 Then
       For Each vrtSelectedItem In .SelectedItems
           path = vrtSelectedItem
       Next vrtSelectedItem
   End If
End With

フォルダ

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim vrtSelectedItem, vrtSelectedFolder As Variant
With fd
   If .Show = -1 Then
       For Each vrtSelectedItem In .SelectedItems
           path = vrtSelectedItem
       Next vrtSelectedItem
   End If
End With

3.ファイル・フォルダパスの年月を可変にする

パスの年・月を置き換える

yPosi = InStr(path, "YY")
path = Replace(path, yPosi, 1, nowY)
           
mPosi = InStr(path, "MM")
path = Replace(folderpass, mPosi, 1, nowM)

置き換えた文字を年・月に戻す

If path Like "*" & nowY & ".*" = True Then
   path = Replace(path, InStr(path, nowY), Len(nowY), "YY")
Else
   errMsg = errMsg & vbCrLf & "「年」が見つかりませんでした。指定したファイルと入力した年が入力一致していることを確認してください。"
End If

If path Like "*" & nowM & ".xls" = True Then
   path = Replace(path, InStr(path, nowM ), Len(nowM), "MM")
Else
   errMsg = errMsg & vbCrLf & "「月」が見つかりませんでした。指定したファイルと入力した月が一致していることを確認してください。"
End If

4.タブの色で処理に使用するシートを配列に抽出する

Function nowWorksheets()
   Dim ws As Worksheet
   Dim ary() As String
   ReDim ary(0)
   For Each ws In Sheets
       If ws.Tab.Color = 65535 Then 'yellow
           ReDim Preserve ary(UBound(ary) + 1)
           ary(UBound(ary)) = ws.name
       End If
   Next
   ReDim Preserve ary(UBound(ary) - 1)
   nowWorksheets = ary()
End Function

例ではタブの色が黄色の場合、配列にシート名を入れています。

（でも、これが必要になるような場面ならそもそものエクセル管理方法考えたいって提言出来たら嬉しいですね……）

5.シートの有無判定

Function ExistsWorksheet(ByVal name As String)
   Dim ws As Worksheet
   For Each ws In Sheets
       If ws.name = name Then
           ExistsWorksheet = True
           Exit Function
       End If
   Next
   ExistsWorksheet = False
End Function

dictionaryにexistがあるからシートもあるだろと思ったらエラーって言われて頭を傾げた同士いないでしょうか。頭を傾げたので、絶対あるやろと思ったら自作してる人が居たので借りて使ってます。

VBA シートが存在するか確認する

6.シートを並び替える

With Worksheets.Add
   For i = 1 To Worksheets.Count
       .Cells(i, 1).Value = Worksheets(i).name
   Next i
   .Range("A1").CurrentRegion.Sort .Range("A1")
   Worksheets(.Cells(1, 1).Value).Move Before:=Worksheets(1)
   For i = 2 To Worksheets.Count
       Worksheets(.Cells(i, 1).Value).Move after:=Worksheets(i - 1)
   Next i
   .Delete
End With

自分で作った結果「私が居なくなった後編集する人大変そうだな……」ってなったので、ほぼまるっと使わせてもらってます。

Excel VBA ワークシートを昇順に並べ替える

7.タブの色をランダムに変更する

Dim r, g, b As Integer
Dim ws As Worksheet
Dim cary() As String
ReDim cary(0)
Dim clr As String
Dim res As Variant
For Each ws In Worksheets
changeset:
   r = Int(255 * Rnd)
   g = Int(255 * Rnd)
   b = Int(255 * Rnd)
   clr = r & g & b
   If UBound(cary) <> 0 Then
       res = Filter(cary, clr, True)
       If UBound(res) > -1 Then
           GoTo changeset
       End If
   End If
   ReDim Preserve cary(UBound(cary) + 1)
   cary(UBound(cary)) = clr
   ws.Tab.Color = RGB(r, g, b)
Next

色重複避けに配列に入れてます。逆に、グループは同じ色にするとかも同じ感じで入れられるのでこのまま紹介。

8.セル範囲に下線を引く

setBorderにセル範囲を入れるだけ。そもそも罫線の設定がとても面倒くさいので、ミニマムにして何時でもコピペできるようにするのが目的でした。

Dim setBorder As Range
With setBorder.Borders(xlEdgeBottom)
   .LineStyle = xlContinuous
   .ColorIndex = xlAutomatic
   .Weight = xlMedium
End With

ユーザーに操作させる

1.使用するシートを選択させる

load Form
Dim ws As Worksheet
For Each ws In Worksheets
   Form.box.AddItem(ws.name)
Next

Form.show

With Form.box
   selectSheet = .List(.ListIndex)
End With
Form.box.Clear
Unload Form

シートの名前が固定ではない場面とか色々あるので大体ファイルを開くのとセットで使いました。

Formを作ってセレクトボックスを入れるだけ。送信ボタンでも付けて押したらhideするだけなので、楽です。

実際に使わせてもらったすごいやつ

1.自作カレンダーコントロール

コピペするだけ！ExcelVBAでカレンダーコントロールを自作する | 株式会社ジャガーノートブログ

以上でした！

検索すれば使い方使いみち云々カンヌンわかると思うので、検索さぼって全部人に教えてほしいみたいな方は、投げ銭していっていただけると幸いです。