カテゴリー: ちょっと処理

Dim zzループ用セル As Range 'Forループ用のRange型変数
Dim zz対象セル As Range  '削除対象のセルの代入先のRange型変数

'指定セル範囲を全てループする
For Each zzループ用セル In Range("A2:A16")
'セルが空白なら削除対象とする
If zzループ用セル = "" Then
'対象セル変数が取得されているかで分岐
If zz対象セル Is Nothing Then
Set zz対象セル = zzループ用セル
Else
'取得されていればUnionメソッドを使用してセル範囲を追加
Set zz対象セル = Union(zz対象セル, zzループ用セル)
End If
Else: End If
Next zzループ用セル

'ループ終了後にセルが取得されているかを判定
If Not zz対象セル Is Nothing Then
'取得されていれば対象範囲を削除する
zz対象セル.EntireRow.Delete
'↓テーブル機能利用時はテーブルの列範囲内でなければエラーとなるので以下を利用する
'Intersect(zz対象セル.EntireRow, Range("A:D")).Delete
Set zz対象セル = Nothing
Else: End If

ループ処理で判定を行いつつ不要行の削除や挿入を行う際には、実際の削除処理を実行するタイミングが処理上で注意が必要です

というのも、セルのループをする場合は基本はForEachループを利用しますが、このループ処理では最初に指定のセル範囲を代入することになります
ループ中に削除を行うと、代入したセル範囲が矛盾を起こしてしまいます
処理の組み方次第では実行時エラーとなります

ループ処理で削除や挿入を行う際には、ループ処理中にメソッドは実行せずに対象セルを取得して、ループが終了してから一括で実行することで矛盾の発生を無くす事と処理速度の向上を実現できます

その際に利用するのはRange型の変数だけです
この変数に削除対象となるセル自体を代入していきます
ただ削除対象をそのままループで代入しても、前回のセルが上書きされてしまいますのでUnionメソッドを利用してセル範囲を追加していきます

ループ判定が終了した段階で、対象セルが取得されていればその範囲に対して一括でDeleteメソッドで削除を行います

コード利用の意味について

この目的は空白行など不要な行を削除するだけの処理です
なので、特別な処理は必要なく単純にIF分岐を利用して条件に一致する行を削除してしまえば良いだけに感じると思います

この画像は処理を実行する前の状況の画像です
このシートのテーブルデータのうち、A列のセルが空白になっている行を削除したい処理になります

コードはうまくいかないコードなので、画像内で見にくいですが確認してください
流れとしてはA列の指定セル範囲をForEachループで回しています
その際にセルが空白であれば行全体を削除しています

こちらの画像が処理を実際に実行したあとのモノです
一見して分かるように空白行が残ってしまっています

さらに確認してもらいたいのが、画像左下のイミディエイトに出力されたループ処理で実行されたセルのAddress文字列です

ForEachループではA2～A16までを代入して実行しているのに、A11までしかループが実行されていません

これはループ中に削除を行うことにより対象のセル数が減少していること
さらに削除した時点で、ForEachループの参照するセルが存在しなくなったことで自動的に次のセルを参照してしまっているため、連続した空白行の部分がうまく処理できていない状況です

これはそもそも仕様に対処する場合には、ループ処理を上からではなく下から行うことで対処することは出来ます
ですがその場合ForEachループは利用できなくなります

コード解説

記事コードの流れで処理を組むことで、目的の達成と処理速度の向上を図れます

この画像は上記のコード実行前から記事コードを実行した後の状態の画像です
今回はしっかりと空白行が無くなっていることが分かると思います

この画像はイミディエイトに出力されたものです
ForEachループで指定したセル全てがしっかり処理されていることが確認できると思います

Dim zzループ用セル As Range 'Forループ用のRange型変数
Dim zz対象セル As Range  '削除対象のセルの代入先のRange型変数

最初に使用する変数の宣言です
この処理ではRange型変数を2個使用します

1つはForEachループ用の変数です
もう1つは削除対象のセルを取得する変数です
ここに代入したセル範囲に対して削除を実行します

'指定セル範囲を全てループする
For Each zzループ用セル In Range("A2:A16")

～～中略～～

Next zzループ用セル

ForEachループの個所です
ここではとりあえずとして、セル範囲は決め打ちの処理になっています
実際にはワークシートのセル範囲であればUsedRangeやCurrentRegionのプロパティや画像のようなテーブル範囲であればListObjectsオブジェクトの各プロパティ等を利用してセル範囲を取得してください

'セルが空白なら削除対象とする
If zzループ用セル = "" Then

～～中略～～

Else: End If

削除条件を設定するIF分岐個所になります
ここの条件を変更することで削除対象を変更することが出来ます
逆に空白ではない行を削除したり、特定の値を対象とすることも出来ます

'対象セル変数が取得されているかで分岐
If zz対象セル Is Nothing Then
Set zz対象セル = zzループ用セル
Else
'取得されていればUnionメソッドを使用してセル範囲を追加
Set zz対象セル = Union(zz対象セル, zzループ用セル)
End If

削除条件に一致するセルであった場合は対象セル変数に代入させます
しかし、そのまま代入すると新しいセルで上書きされていってしまいますので、すでに取得対象が存在する場合は既存のセル範囲を残して追加する必要があります
そのためUnionメソッドを利用して、取得済み範囲に追加してきます

ただ、このメソッドは2つ以上のセル範囲を追加するメソッドのため
未取得のNothingではエラーとなります
そのため、最初に取得済みかどうかの判定を行ってから、取得済みでなければループ変数のセル範囲を代入して、取得済みであれば既存の範囲に追加します

この後で行全体選択のプロパティ等を利用するので、この時点の取得範囲はセル単体の追加でも問題はありません

'ループ終了後にセルが取得されているかを判定
If Not zz対象セル Is Nothing Then
'取得されていれば対象範囲を削除する
zz対象セル.EntireRow.Delete
'↓テーブル機能利用時はテーブルの列範囲内でなければエラーとなるので以下を利用する
'Intersect(zz対象セル.EntireRow, Range("A:D")).Delete
Set zz対象セル = Nothing
Else: End If

ここはループを抜けてきた後の処理になります
ループはあくまでも削除対象のセルを判定して取得を行うためのものになります
つまり、この時点で削除対象が必ず存在しているということは分かりません

ループを抜けてきた時点で対象セル変数がNothing（初期値）となっているかどうかで存在確認が出来ます
Nothingはオブジェクトなので、比較演算子はIsを利用する必要があります
この比較演算子は反対の意味の演算子が無いので、Notを利用して逆説にすることで、Nothingではない（対象セルが存在する）という条件が成り立つときに削除処理を実行します

取得した対象セルは単一セルなので、行全体を指定するためにEntireRowプロパティを利用して削除を実行します

ただここで問題がある場面がテーブル機能の場合になります
テーブル機能範囲の行を削除する場合に連続していない行全体を削除しようとすると画像の実行時エラーが発生します

このエラーが発生して、Deleteメソッドが実行できません
その場合にはコメントアウトされているコードを利用してください

'↓テーブル機能利用時はテーブルの列範囲内でなければエラーとなるので以下を利用する
'Intersect(zz対象セル.EntireRow, Range("A:D")).Delete

こちらのコードはテーブル機能を利用している場合に利用するコードになります
テーブル機能の範囲を削除を行う場合には、テーブル機能の列範囲と同じ列範囲を指定する必要があります

ここでは決め打ちの列指定ですが、実際に使用する場合はDataBodyRangeプロパティ等を利用して列範囲を取得するようにするといいです

ちなみにこのセルを変数に代入させて、あとでまとめて一括で処理を行う方法は処理向上にとても貢献します
削除だけでなく、挿入やセルの書式設定等や一括入力などにも利用できます

'見出し1行を除外した範囲選択
Range("A1").CurrentRegion.Resize(Range("A1").CurrentRegion.Rows.Count - 1, Range("A1").CurrentRegion.Columns.Count).Offset(1, 0).Select

表のデータを取得する際によく使用するのが、見出しの範囲を除外してデータの範囲のみだけを取得する処理です

このコードを使用すると、画像の様に見出しが1行の場合にその行以外のデータ範囲を選択状態にします
プロパティを複数使用する為、1行のコードが長くなってしまうので少しぱっと見わかりにくいかもしれませんが分割して確認すれば簡単な内容で取得出来る事が分かります

コードの解説

コードの解説を行うにあたって、このままでは少し分かりづらいので分割してコードを書いてみます
やっていることは全く同じですが、アクティブセル等の動的なセル指定を行っている点は少し違うことを認識しておいてください

分割して実行していくと、コードは画像のように分割することができます
このコードを1行ずつ解説を行います
なお、最初のA1選択は便宜上のモノなので解説は割愛します

ActiveCell.CurrentRegion.Select

最初に全てのデータ範囲を取得しておきたいので、CurrentRegionプロパティを使用して表範囲全体を取得します
この状態では当然、見出しも含まれています

Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count).Select

次にResizeプロパティを使用して範囲サイズを変更します
この例での表では見出しが1行なので、行数を1減らすことでデータ範囲の行数を取得する形になります

なので、ここの数値を変更すれば見出しの行数の変動にも対応出来ます

ただ、Resizeプロパティは範囲の左上からのサイズ変更になりますので、このままだとデータ範囲の最終行が除外されてしまいます

Selection.Offset(1, 0).Select

選択範囲を1行下に移動させることで見出し分を除外させます

ここまでの動きを記事コードでは一括で実行しています
コードが長くなり可読性が低いと思いますので、変数に代入させることで少しわかりやすくなるかもしれません

Dim zzデータ範囲 As Range
Set zzデータ範囲 = Range("A1").CurrentRegion

zzデータ範囲.Resize(zzデータ範囲.Rows.Count - 1, zzデータ範囲.Columns.Count).Offset(1, 0).Select

Set zzデータ範囲 = Nothing

このコードの様に表範囲をセル変数に代入させておけば、少しコードを短くすることができます

範囲を取得したいだけならクドくなりますが、この取得した範囲に対して処理を行う場合にはとても有効な方法です

'選択範囲をクリップボードにコピー
Selection.CopyPicture

Dim グラフ範囲 As ChartObject, ファイルサイズ As Long
'空白のグラフ範囲を新規作成する、サイズは選択範囲と同じサイズにする
Set グラフ範囲 = ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height)
'空白のグラフ範囲を画像ファイルとして保存
グラフ範囲.chart.Export ThisWorkbook.Path & "\セル範囲画像.png"
'そのファイルのサイズを整数変数に取得
ファイルサイズ = FileLen(ThisWorkbook.Path & "\セル範囲画像.png")
'空白のファイルサイズを超えるまでループする
Do Until FileLen(ThisWorkbook.Path & "\セル範囲画像.png") > ファイルサイズ
'クリップボードにコピーしたセル範囲画像を貼り付け
グラフ範囲.chart.Paste
'貼り付けしたグラフ範囲を画像ファイルとして保存
グラフ範囲.chart.Export ThisWorkbook.Path & "\セル範囲画像.png"
'CPUの解放
DoEvents
Loop
'作成が完了したらグラフ範囲は削除して解放
グラフ範囲.Delete
Set グラフ範囲 = Nothing

Excelのワークシート上で綺麗に仕上げたセル範囲が完成しました
整然と並んだデータ群と、目に優しい柔らかな配色
見やすさを考え抜いた文字種とサイズ
生データのままではなく、見やすく入力しやすくした表示形式

はい、画像として保存しておきたいですよね？
ただのコピペじゃ、貼り付けられない表現力を遺憾無く見せつけられるのが画像化です

コードを使用してデータのある範囲を画像として保存してみます

この画像はスクショではありません、コードを実行して保存した画像です
指定範囲を切り取り作業無しで保存できます
このピッタリのセル範囲画像の気持ちよさは、思わず職場のPCのデスクトップ背景に設定してしまうのではないでしょうか

そうですね、言いたいことは分かります
最初にあれだけ書式設定をがんばって作ったとか言ってたのに、例画像がまったく頑張ってへん！というのは心にしまっておいてください

コード解説

程よく脱線というか、そもそも入線すらしてなかったところで、コード解説です

先に大まかな処理の流れを解説します

まず、セル範囲を画像として保存するにはその範囲をスクショ的なことをします
ただ、それを画像ファイルにする事は直接出来ないため、それが可能なグラフ範囲を使用します
このグラフ範囲にスクショ的なやつを貼りつけて、それを画像として保存します

'選択範囲をクリップボードにコピー
Selection.CopyPicture

まずは、セル範囲をスクショ的なやつします
それが、このCopyPictureメソッドです

このメソッドは、セル範囲をクリップボードに画像として取得します
なので、このまま他の場所にペーストすれば画像を貼り付けられます

今回はファイル保存なので、後に続きます

Dim グラフ範囲 As ChartObject, ファイルサイズ As Long

ここで使用する変数の宣言です
この処理で使用する変数は2つです

1つ目はグラフ範囲を取得するObject型の変数です
固有の型指定としてChartObject型を指定します
これはグラフ範囲のObjectです、この中に実際のグラフ範囲やタイトル範囲などのObjectがあります
その一部にコピーした画像を貼り付けます

と、いうのもクリップボードにコピーした画像をファイルとして保存するメソッドはありません
これをどこかに貼り付けてファイル保存する必要があり、それが可能なのがグラフ範囲になります

なので、作成後もいろいろ操作をするので変数に取得させておくほうが便利です

2つ目の変数はファイルサイズの整数値を取得させる変数です
この利用理由は後述します

'空白のグラフ範囲を新規作成する、サイズは選択範囲と同じサイズにする
Set グラフ範囲 = ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height)

グラフ範囲を作成します
ここで作成されるグラフは何もない真っ白なグラフ範囲になります

グラフの作成にはChartObjects.Addメソッドを使用します
引数は、作成する位置と大きさのサイズになります

最初の2つが位置設定になりますが、この処理では位置はどこになっていても関係ないので「0」を指定します

後半の2つの設定が、サイズ設定になります
ここでは選択範囲と同じサイズにする必要がありますので、Selectionに対する高さと横幅を指定するようにします

これで、選択範囲と同じサイズのグラフ範囲が完成します
完成と同時に、その作成されたグラフを変数に代入します
これ以降は、この変数名でグラフを操作します

'空白のグラフ範囲を画像ファイルとして保存
グラフ範囲.chart.Export ThisWorkbook.Path & "\セル範囲画像.png"

まずは、クリップボードの画像を貼り付けする前に空白のグラフを画像として保存します

chart.Exportメソッドを使用することで、グラフ範囲を画像として保存することができます
引数には保存パスを絶対パスで指定します、この時にファイルの拡張子まで指定しますが他の画像拡張子も利用可能ですが、その場合は2つ目に省略された引数FilterNameを対応するものに変更します
ここでは、省略していますが省略した場合はPNGが指定されます

これは、後で必要になる手順の準備です

'そのファイルのサイズを整数変数に取得
ファイルサイズ = FileLen(ThisWorkbook.Path & "\セル範囲画像.png")

上で作成した空白の画像ファイルのサイズを整数値で取得します
ファイルサイズの取得にはFileLen関数を使用します
引数に指定されたファイルのサイズが整数値で返されますので、それを変数に取得します

これは、この処理自体の問題点に起因します
この処理では選択範囲をクリップボードに貼り付ける際、クリップボードの処理がVBAでは行っていないため、VBAで後述の貼り付け操作をする際にクリップボードが更新されておらず、真っ白なまま画像として保存されてしまいます

時間での待ちでも構わないのですが、貼り付けたいセル範囲が大きな場合その時間が不足する場合があります
そこで、空白のファイルサイズを取得しておき画像を貼り付けたファイルサイズと比較することでしっかり貼り付けられたことを認識することができます

空白の画像ファイルは小さいし、画像が貼り付けられれば間違いなくこの空白の画像よりサイズが大きくなります
逆になることは確実にあり得ませんし、画像が貼り付けられても同じサイズということもあり得ません

この方法なら、小さい画像であれば無駄な待ち時間も発生しないのもいいね

'空白のファイルサイズを超えるまでループする
Do Until FileLen(ThisWorkbook.Path & "\セル範囲画像.png") > ファイルサイズ
・・・
Loop

上記でくどくど説明した、ファイルサイズを比較している部分です
このDoループは空白のファイルサイズと改めて保存された画像ファイルのサイズを比較して、新たに保存された画像ファイルの方がファイルサイズが大きければ処理を終了します

間違いなく最初に1回は実行されます

'クリップボードにコピーしたセル範囲画像を貼り付け
グラフ範囲.chart.Paste

ファイルサイズが超えていなければ、クリップボードのデータを貼り付けします
この時点でグラフ範囲にセル範囲画像が貼り付けられます

上記にもあるように、クリップボードの処理が追い付いていない場合はこの時点でも空白のグラフ範囲になる場合があります

'貼り付けしたグラフ範囲を画像ファイルとして保存
グラフ範囲.chart.Export ThisWorkbook.Path & "\セル範囲画像.png"

グラフ範囲を改めてここで保存しなおします
同名のファイルがあった場合は自動的に上書きされるので、メッセージの抑止は不要です

というか、その点は無条件上書きなので注意が必要です

'CPUの解放
DoEvents

貼り付けがうまくいかない時は、クリップボードの処理が追い付いてない時になりますので、それを処理してもらうためにここでDoEvents関数でCPUを解放しています

'作成が完了したらグラフ範囲は削除して解放
グラフ範囲.Delete
Set グラフ範囲 = Nothing

ループを抜けたということは、しっかり画像が貼り付けられた画像ファイルが生成されたことを意味します
なので、不要になったグラフ範囲を削除します
変数の参照も解放しておきましょう

では、記事コードで本気の書式設定セル範囲を画像保存してくださいね！

'選択中の最終セルを選択する
Selection.Cells(Selection.Cells.Count).Select

セル選択をした状態で、そのセル範囲の最後のセルのみを選択状態にするコードです

主に表を作成したりして、そのセル範囲の最後のセルを単一で指定したい場合に使用します

使用例

'使用済みの最終セルを選択する
ActiveSheet.UsedRange.Select
Selection.Cells(Selection.Cells.Count).Select

実際のコード使用時の動きの確認を行います
今回の作成コードはこんな感じのコードです

目的としては、保存に時間がかかるブックのため頻繁に保存を実行できないブックで、表を整えるたびに最終セルを取得していきたい場合です

SpecialCells(xlCellTypeLastCell)メソッドでも最終セルは取得できますが、上記の条件のように表の改変を行いつつ、保存を実行しない場合はうまく取得できません

ActiveSheet.UsedRange.Select

そこで、UsedRangeプロパティを使用することで保存に影響を受けずに最終セルの取得を行うことが出来ます

しかし、このプロパティでは範囲選択されてしまうため
実際どこが最終セルなのかが分かりません

Selection.Cells(Selection.Cells.Count).Select

そこで、記事コードを連続して使用することで最終セルのみを選択状態にできます

このコード自体は非常にシンプルな内容です

「Selection.Cells」という部分で、選択中のセル範囲のセル全体を表しています
そこに「()」でセルを相対的に指定することが出来ます

行列番号を指定する事以外に、セルのインデックス番号を使用することもできます
今回はこのインデックス番号で処理を行います

そして、インデックス番号は「Selection.Cells.Count」となっています
選択中のセル範囲のセル全体は上記のとおりです、そのセル全体の個数を取得しています
範囲選択のセル個数が100個あれば「100」が取得されます

このセルのインデックス番号は配列とは違い、1から始まるのでそのままの数値で最終セルを指定することが可能になります

Selection.Cells(1).Select

数値での指定を行えますので、このようにすれば選択範囲の1番目のセルを選択状態にできます

まあ、選択範囲が1つであればそこはActiveCellになるので、あえて指定することはあまりありませんが可能ではあります

'Unicodeから文字入力
ActiveCell = ChrW(9451)

'Unicodeの文字コードを取得
Debug.Print AscW(ActiveCell.Text)

VBAで無効な環境依存文字について

PCの環境によって使用ができる「環境依存文字」という特別な表現をする文字があります

画像のような文字になります
これは「１１」の変換で出てきた文字なのですが、これを見ているPCでは存在しないかもしれません、それが環境依存文字です

さらにこの文字の困ったことに、VBAで認識されない文字が存在しています
画像の文字の場合に、アクティブセルの文字列をイミディエイトに出力しようとすると「?」が返されます

これはVBAで存在しない文字列のため、表現ができない文字になります
PCの環境で使用できるはずが、VBAははじいてしまいます
わがままな困ったさんではありますねぇ

なので、これをワークシートに入力しようとして「?」を指定しても、当然「?」が入力されるだけで画像の文字を入力することは出来ません

コード解説

そこで使用するのがChrW関数です

ActiveCell = ChrW(9451)

この関数はUnicodeの文字コードで指定した文字を返す関数です
このコードを実行すると、アクティブセルに画像の環境依存文字を入力します

VBAでは無効なので、イミディエイトに出力しても「?」になるだけですが、ワークシートに出力すればちゃんと文字が入力されます

またメモリ上であれば取得は出来ているので、変数に取得させることも可能です

ただ、この文字コードは大量にあり、とても掲載できるレベルのものではありませんので調べる必要があります

Debug.Print AscW(ActiveCell.Text)

AscW関数を使用することで、指定文字のコードを調べることが出来ます
この関数は引数に指定した文字の1文字目のUnicodeの文字コードを返す関数です

この関数で使用したい環境依存文字のコードを調べたうえで、ChrW関数を使用すれば入力することが出来ます

基本的には環境依存なのであまり使用したくない文字種ですが、やはり「㈱」なんかは結構便利なので使いたくもなります

ちなみに、このUnicodeはMac版ではAscW関数でコードの取得はできません

まず、この画像のような表があるとします
毎日なんらかの確認作業を行い、確認完了後にチェックを付ける表です

単純に○を入力するだけのなんてことない表ですが、これが項目数が大量にあった場合は結構大変になります
画像は結果表示なので一気に入力されてますが、実際は1つずつ入力する必要があります

そこで、セルをダブルクリックするだけでチェックを入力して、間違った時のことも考えて、ダブルクリックで○と空白を切り替えるようにします
こうすると、結構入力が楽になります

まずは、処理上選択されているセル範囲のみで実行する必要があります
見出しや日付のセルに○が入力されると困ります

名前定義セルの作成

処理したいセル範囲を選択して、数式タブにある名前の管理ボタンからセル範囲に名前定義を作成します

名前の管理画面から新規作成ボタンを選択します

表示された新しい名前画面から、新規作成内容を設定します
名前はなんでも構いませんが、範囲はシート範囲にするようにしてください

シートを複製しても処理が問題なく動作できるように、名前定義の範囲を限定しておきます

シートイベントの作成

シートのイベントプロシージャで処理を作成していきます

今回の処理では、ユーザーの意思による操作で誤操作の可能性の低いダブルクリックを選択します
ダブルクリックは、ワークシート上では編集モードに入る操作なので無意識にしてしまうことは少ないのでこういった処理に向いています

ダブルクリックをしたときに発生するイベントが「BeforeDoubleClick」イベントになりますのでシートモジュールでプロシージャボックスから選択して作成してください

今回作成したコードがこのような形になっています

コード解説

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Range("チェック範囲"), Target) Is Nothing Then
        Cancel = True
        If Target = "○" Then
            Target.ClearContents
        Else
            Target = "○"
        End If
    Else: End If
End Sub

このコードでは、ダブルクリックされたセルが指定範囲であれば入力処理を実行します
入力処理では、空白セルには○を入力し、○が入力されていれば消去する処理です

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

シートイベントです。
シートのセルをダブルクリックした後に発生するイベントで、引数Targetにダブルクリックしたセルが代入されます

Targetにはセル範囲が代入されますので、単一セルとは限りません
ですが、ダブルクリックはExcelの仕様上必ず1セルに限定されます
この仕様からもダブルクリックイベントは使いやすいです

    If Not Intersect(Range("チェック範囲"), Target) Is Nothing Then

～～　中略　～～

    Else: End If

        Cancel = True

このコードを実行すると、既定の動作をキャンセルします
イベントによって規定の動作は変わります

ここではセルの編集モードに入るのをキャンセルします
最後に解説しますが、入力モードに入られると非常にわずらわしいです

        If Target = "○" Then
            Target.ClearContents
        Else
            Target = "○"
        End If

最後に入力処理になります

If分岐でセルに○が入力されているかで分岐します
○が入力されていれば、ClearContentsメソッドにより入力内容を消去します
○以外であれば、○を入力します

○以外の別の文字列でも○を入力します
これはCOUNTIF関数を使用したことがある人は分かるかもしれませんが、○をカウントするのに別の文字を入力されていてうまく個数が取得できないことがあります
そういったことを回避する意味でも指定文字以外なら指定文字にしてしまいます

動きの解説

まずは空白セルに○を入力する動きです
セル範囲が処理実行可能範囲なので、処理が実行されます
またCancelにTrueを代入することで、ダブルクリックしたセルが編集モードに入りません

空白セルで○以外セルなので、○が入力されてい処理が完了です

今度は○が入力されているセルをダブルクリックしたときの動きです

今回は○が入力されているため、そのセルは空白になります

最後に処理が許可されていない範囲をダブルクリックしたときの動きです

日付セルは名前定義したセルとは重複していないため、最初のIf分岐で何も処理を実行しない形になっています

このとき、Cancelも変更されていないため、通常の操作通りセルの編集モードに入っていることが確認できます

この処理は、入力処理ですが非常に応用範囲が広い内容です

例えばセルへのデータ入力ではなく書式設定の変更を行えばダブルクリックでセルの背景色を切り替えたりできます
ユーザーフォームの表示処理を行うことも可能です、この場合表示ボタンが必要なくなります

まずは入力処理から行って、動きが確認できたら色々な設定変更を行ってみてください

'アクティブセルがB列か判定
If Not Intersect(Range("B:B"), ActiveCell) Is Nothing Then
Debug.Print "範囲内"
Else: End If

任意のセル範囲が指定セル範囲に含まれているかを調べるにはIntersectメソッドを使用します

コード解説

任意のセル範囲とは、ユーザーが選択しているセル範囲であったりする
動的に変化する指定セル範囲のことになります
このコードでは、ActiveCellの部分になります

指定セル範囲とは、処理の実行を前提とした固定の指定セル範囲のことになります
ActiveCellがこのセル範囲内にあれば処理を実行するような判定の親要素のセル範囲になります
コードでは、Range(“B:B”)になります

このコードを実行した時点のアクティブセルの位置によって処理が分岐します
引数のセル範囲は順番は関係ありませんので、入れ替えても使用可能です

If Not Intersect(Range("B:B"), ActiveCell) Is Nothing Then

ここで条件分岐を行っています

Intersectメソッドは重複する範囲が存在しない場合は「Nothing」を返します
Nothingは文字列ではないので、比較には「Is」演算子を使用します

これで、重複する範囲が無い時はTrueとなります
ただそれでは処理上少しわかりにくいので、逆説を取って判定します

その為に「Not」演算子を合わせて使用します
これで、範囲内に存在する場合にTrueになります

主な使用場面

ユーザーにセル範囲を指定させて処理を実行するような場合には、必ず使用します

データを入力したり、背景色を変更したりするような処理であった場合に、見出しのセル範囲であったり、関数の入力されたセルを指定されては困ります
そういった場合に、処理の実行前にこのコードで実行可否を判定します

また、Range(“B:B”)の部分を名前定義セルにすれば複雑なセル範囲も簡単に指定できますのでおすすめです

埋め込みコントロールはワークシートにコントロールを作成したものです
このコントロールはワークシートの広さから、往々にしてコントロールの数が多くなります

しかも、ほとんど同じ動きをさせることも多い場合があります

そんな状態で、1つ1つのコントロールにイベント処理を何個も作成していくのは、大変だし、メンテナンス性も劣化します

クラスモジュールを作成する

クラスモジュールが作成出来たら、そのモジュール内にコードを作成します

画像の様なコードを作成しました
プロジェクトウィンドウの青くなっている「Class1」モジュール内です

Dim WithEvents 作成 As MSForms.OptionButton

Sub 紐付け(作成コントロール As MSForms.OptionButton)
    Set 作成 = 作成コントロール
End Sub

Private Sub 作成_Change()
    If 作成.Value = True Then
        Selection.Interior.Color = 作成.BackColor
    Else: End If
End Sub

こちらは、クラスモジュール内に作成するコードなので、OptionButtonの取得であればコピペしてそのまま使用できます

Dim WithEvents 作成 As MSForms.OptionButton

この1行が集約するコントロールを代入させる変数の宣言です
WithEventsを使用することにより、イベントの作成が可能になります

MSForms.OptionButtonはオプションボタンのコントロールです
変数の型指定です、Object型は指定できません

Sub 紐付け(作成コントロール As MSForms.OptionButton)
    Set 作成 = 作成コントロール
End Sub

ここで紐付け処理を作成しています

後述で出てくる紐付け作業の時に、実行されるプロシージャです
中身は引数のコントロールを上記の変数に代入させているだけです
ただ、これだけで以降は後述のイベント処理が実行されます

Private Sub 作成_Change()
    If 作成.Value = True Then
        Selection.Interior.Color = 作成.BackColor
    Else: End If
End Sub

イベント処理です
内容は、OptionButtonがON（True）ならコントロールの背景色を選択範囲に適用するだけです
ここに作成したイベントが紐付けされたコントロール全てで実行されます

もし、イベント処理に変更があった場合はここの処理を変更すればいいだけです
コントロールの数が10個あろうが100個あろうが、ここで全てが集約されています

考えるだけで便利な話です

ここまでで、クラスモジュールの作成は完了です

シートモジュールの処理作成

クラスが作成出来たら、それを使用してシートモジュールに処理を作成します

画像の様なコードを作成しています
モジュールは青色になっている、「Sheet1」モジュールになります

Dim 動的作成() As New Class1

Private Sub Worksheet_Activate()
    Dim 取得用 As Shape, インデックス As Long
    For Each 取得用 In ActiveSheet.Shapes
        If 取得用.Name Like "*OptionButton*" Then
            ReDim Preserve 動的作成(インデックス)
            動的作成(インデックス).紐付け OLEObjects(取得用.Name).Object
            インデックス = インデックス + 1
        Else: End If
    Next 取得用
End Sub

Private Sub Worksheet_Deactivate()
    Erase 動的作成
End Sub

Private Sub CommandButton1_Click()
    Selection.Interior.ColorIndex = 0
    Erase 動的作成
End Sub

こちらは、コントロールの名前が違っていると使用できませんのでコピペする場合は修正をしてください

Dim 動的作成() As New Class1

クラスを使用する場合には、クラスの作成が必要になります
この1行が、クラスの作成とその変数の宣言になります

コントロールの個数分この変数が必要になるため、変数は動的配列で作成します
またNewキーワードによりクラスがここで作成されています

Private Sub Worksheet_Activate()
    Dim 取得用 As Shape, インデックス As Long

シートのActivateイベントを使用します、シートがアクティブ状態になったときに発生するイベントです

まずは使用する変数の宣言です
「取得用」はシートに配置されたコントロールをループ処理で代入させるための変数です。配置されたコントロールは全てShapesオブジェクトとなるため、型指定はShape型を使用します。ここには図形なんかも入ってきます

「インデックス」は動的配列のインデックス番号用の数値で使用します。整数なのでLong型を使用します

    For Each 取得用 In ActiveSheet.Shapes

～～　中略　～～

    Next 取得用

次にシートに配置されたコントロールの取得処理に入ります
ここではシート上のShapesオブジェクトをForEachループで1つずつ検証しながら取得を行っていきます

変数の取得用に各オブジェクトが代入されます

        If 取得用.Name Like "*OptionButton*" Then

～～　中略　～～

        Else: End If

オブジェクトの取得ができたら、そのオブジェクト名で取得可否の条件分岐を行います

If分岐で文字列比較を行います
今回はオプションボタンを取得するので、名前に「OptionButton」が含まれていたら処理を中略の処理が実行されます

含まれていなければ何も行いません

            ReDim Preserve 動的作成(インデックス)

取得可能なコントロールが見つかったら、まずは動的配列を追加します
もちろんそれまでに取得したコントロールを削除されていは困りますのでPreserveキーワードを使用してください

変数インデックスはあとで加算しています

            動的作成(インデックス).紐付け OLEObjects(取得用.Name).Object
            インデックス = インデックス + 1

ついにクラス定義の出番です
ここまで長かったです、書いてる自分もお尻が痛いです

まず、クラス宣言した変数名ではクラスモジュールで作成したメソッドやプロパティが使用できます

今回は、紐付けという処理を作成しました
それはメソッドという形でここで使用することが出来ます
変数に対するメソッドなので、「.」を付けることでインテリセンス入力できます

これはCallによる処理の呼び出しでは無いので、引数に「()」は必要ありません
半角スペースを入れてから、引数を指定します

今回は「OLEObjects(取得用.Name).Object」となっています
まずもって、そのままでは取得できません
変数「取得用」がShape型だからです

なので、コントロールとしてのオブジェクトで指定する必要があります
OLEObjectsはシートにあるコントロールのコレクションです
その中から取得用.Nameで指定することで取得しているコントロールを指定することができます
指定したコントロールのObjectプロパティを指定することで最終的にコントロールが指定される状態になります

この時点でクラスの紐付けプロシージャが実行されて、クラスで宣言した変数「作成」に代入されます

ここ以降にクラスで作成したイベントがこのコントロールで実行されるようになります

紐付けが出来たら、変数「インデックス」に1を加算します

ここまでで、処理の作成が完了です、おっつかれした～

処理の動きと紐付けの解除

まずは、シートのアクティブイベントを実行する必要があります

Sheet2からSheet1への切り替えを行っています
この時点でOptionButtonのクラスの紐付けが完了しています

実際にOptionButtonを切り替えてみると、選択範囲の背景色がOptionButtonのONのものと同じに切り替わっています

OptionButtonが増えたとしても、問題は無いしコントロールの背景色を変更すれば変更後の色指定も合わせて行えます

Private Sub Worksheet_Deactivate()
    Erase 動的作成
End Sub

また、このDeactivateイベントにより動的配列変数を解放しています
このイベントはシートがアクティブ状態でなくなったときに発生するイベントなので、別のシートに移動したら紐付けを解除する動きになります

状況によっては必要ないかもしれません

Private Sub CommandButton1_Click()
    Selection.Interior.ColorIndex = 0
    Erase 動的作成
End Sub

解放自体をユーザーにゆだねることも出来ます
その為にコマンドボタンを1つ作成しています

コマンドボタンをクリックすると、背景色を塗りつぶし無しに設定します
その後、動的配列変数を解放しています

画像の動きを確認してください

ボタンをクリックすることで、背景色が無くなり、Redのオプションボタンに切り替えても背景色は塗られることはありません
イベントが発生していないことが確認できます

動的配列でメモリ上に乗っかったままなので、基本的には必要ない時は解放してあげるほうが良いです

複数のコントロール

単一のコントロールだけであれば、全く問題にならないので普通にシートモジュールに作成すればいいです

この記事でもありますが、複数のコントロールになるとこのクラスを使用する方法しかありません

クラス自体は、使用頻度が非常に低く無くても処理作成を行えることが多いため
初心者では踏み込みづらい内容かもしれません

なので、たくさんのコントロールのイベント処理を一括して管理するにはクラス使わなあかん、とだけ認識しておいてください

作成して、紐付けする

画像の様なコードを作成しています

Dim WithEvents 動的作成 As MSForms.TextBox

最初にWitheventsを使用した変数宣言があります
これに代入するテキストボックスに処理を作成できるようになります

Private Sub 動的作成_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
動的作成.BackColor = RGB(0, 200, 0)
End Sub

ここで、動的に作成するコントロールのイベント内容を作成しています
内容としては、マウスカーソルがコントロール上で移動すると背景色を緑色に変更するだけの処理です

Private Sub CommandButton1_Click()
Set 動的作成 = Me.Controls.Add("Forms.TextBox.1", "")
End Sub

ここで、コマンドボタンのクリックによりテキストボックスを作成しています
プロパティ設定は何も行っていないので、作成しているだけです

それと同時に、動的作成に代入を行っています
この代入により、Witheventsで作成した変数と紐付けされるので、以降で作成したイベントが発生するようになります

画像を確認してください、コマンドボタンをクリックするとテキストボックスが作成されます

そのテキストボックスにマウスを移動させると、背景色が緑色に変化します
イベントが実行されていることがわかります

動的に作成したコントロールには、こうして処理を作成しておき
実際に作成された後に紐付け処理を行うことで、使用することができるようになります

紐付けの解除

Set 動的作成 = Nothing

紐付けには変数に代入することで行いました

なので、紐付けの解除は変数を解放してあげればいいだけです
このコードを解除したいタイミングで実行すれば可能です

赤枠内に解除用コードを挿入しました
上記のコードに、紐付け直後に解除する動きになっています

画像のように、テキストボックス作成後にマウスをコントロール上に移動させても背景色が変化しません
イベントが発生していないことがわかります

この仕様をうまく使えば、ユーザーフォームでは使用できないApplication.EnableEventsプロパティの代用ができます

単体でのみ有効な処理

この処理は変数が1つしかありませんので、単体のコントロールでのみ有効な処理です

変数を増やせばいいだけと考えてしまうかもしれませんが、その分イベント処理の作成も同時に増加していきます
こうなると、もはやなんのための処理か分からなくなります

イベント処理は1つで集約して、代入する変数を増やすには、クラスが必要になります
クラスを使用することで、例でいう「動的作成」という変数を配列で指定することが出来るようになります

Excelのイベントであったり、作成するコントロールが単体であればクラスまで使わなくてもこの記事の内容で対応可能です
可読性もこちらのほうが良いので、場面で使い分けるようにすればいいです

’半角の存在確認
Dim 対象文字列 As String
対象文字列 = "ナンバー32"

If LenB(対象文字列) > LenB(StrConv(対象文字列, vbFromUnicode)) Then
Debug.Print "含まれています"
Else
Debug.Print "含まれていません"
End If

コード解説

Dim 対象文字列 As String
対象文字列 = "ナンバー32"

ここでは、引数の文字列が後で複数回でてくるので変数に代入しています

If LenB(対象文字列) > LenB(StrConv(対象文字列, vbFromUnicode)) Then

ここで判定処理を行っています、If分岐を使用しています

LenB(対象文字列)

左辺では、LenB関数によりバイト数を取得しています
VBAでは文字は2バイトを返します

LenB(StrConv(対象文字列, vbFromUnicode))

右辺では、文字形式を変換して半角を1バイトに表現してバイト数を取得しています

この2つの比較により、LenB関数単体より少なければ含まれていることが分かります

If LenB(対象文字列) > LenB(StrConv(対象文字列, vbFromUnicode)) Then
Debug.Print "含まれています"
Else
Debug.Print "含まれていません"
End If

→→→　含まれています

例にある「ナンバー32」という文字列に対して、コードを実行すると「含まれています」が返されます
「32」が半角のため、バイト数が一致しないからです

これは1バイトと2バイト文字という表現に対して有効な処理です
3バイト以上の文字があった場合は別の対応が必要になります
ただ、この対応はかなり稀でありどこまでのバイトを対応するかも難点です