LENB関数を簡単に挿入(ExcelVBA)

ゆーしゃん
2022.02.20
46 views

概要

特定列の文字数(バイト数)を知りたい際に、
アクティブセル(列)の右列に「=LENB(左列)」関数を挿入する

プログラムを作成した理由

CSV変換作業マニュアルを確認していたところ
「入力文字数が上限値を超えている場合は、LENB関数を挿入して文字数を上限値以下に手動調整する」

という作業がありました。

文字数調整はある程度の目視は仕方ないにしても、
「LENB関数くらい自動で挿入したい」
とExcelVBAを書ける後輩が考え、マクロ化して下さいました。

ソースコード

Option Explicit

'概要：アクティブ列_右列にLENB関数挿入
'※改行コードは2バイト計算

Sub LENB挿入()

    '変数定義
    Dim End_Row As Long
    Dim title_str As String
    Dim adrs As String
    Dim check_col As Integer

    Call 高速化設定_開始
    
    'オートフィルター解除
    ActiveSheet.AutoFilterMode = False
    
    'データ最終行取得
    End_Row = ActiveSheet.UsedRange.Rows.Count
    
    '確認列の項目名/列位置取得
    check_col = ActiveCell.Column
    title_str = Cells(1, check_col).Value
    adrs = Split(ActiveCell.Address, "$")(1)
    
    'アクティブセルの右に列挿入　⇒　挿入列の一番上を選択
    Columns(ActiveCell.Column + 1).Insert Shift:=xlToRight
    Cells(1, ActiveCell.Column + 1).Select
    
    'タイトル入力
    Cells(1, ActiveCell.Column) = "文字数確認"
    Cells(1, ActiveCell.Column).Interior.Color = RGB(31, 73, 125)
    Cells(1, ActiveCell.Column).Font.Color = RGB(255, 255, 255)
    
    '書式が「文字列」の横で実行した場合、書式設定が引き継がれてしまうので
    '書式を「標準」に設定
    Range(Cells(2, ActiveCell.Column), Cells(End_Row, ActiveCell.Column)).NumberFormatLocal = "G/標準"
    
    '項目下2行目～最終行まで関数入力
    '※RC[-1]：同じ行で1列左のセルを参照
    Range(Cells(2, ActiveCell.Column), Cells(End_Row, ActiveCell.Column)) = "=LenB(Substitute(RC[-1], ""<BR>"", ""改""))"

    '関数入力したセルの背景色変更
    Range(Cells(2, ActiveCell.Column), Cells(End_Row, ActiveCell.Column)).Interior.Color = RGB(253, 233, 217)
    
    '1行目にフィルタ
    Rows("1:1").AutoFilter
    
    'セル幅をタイトルに合わせて調整
    Selection.Columns.AutoFit
    
    Call 高速化設定_終了
    
    '完了メッセージ
    MsgBox adrs & "列 " & "『" & title_str & "』 ⇒" & " LENB列挿入"
    
End Sub

Private Sub 高速化設定_開始()
    
    'ステータスバー・高速化設定
    With Application
        .DisplayStatusBar = True            'ステータスバー表示
        .StatusBar = ""                     'ステータスバー文言
        .Calculation = xlCalculationManual  '手動計算に
        .ScreenUpdating = False             '画面描画を停止
        .EnableEvents = False               'イベントの連鎖反応を停止
    End With

End Sub

Private Sub 高速化設定_終了()
    
    'ステータスバー・高速化設定終了
    With Application
        .StatusBar = ""                         'ステータスバー文言
        .ScreenUpdating = True                  '画面描画を開始
        .Calculation = xlCalculationAutomatic   '自動計算に
        .EnableEvents = True                    'イベントの連鎖反応を再開
    End With

End Sub

Option Explicit

'概要：アクティブ列_右列にLENB関数挿入

'※改行コードは2バイト計算

Sub LENB挿入()

'変数定義

Dim End_Row As Long

Dim title_str As String

Dim adrs As String

Dim check_col As Integer

Call 高速化設定_開始

'オートフィルター解除

ActiveSheet.AutoFilterMode = False

'データ最終行取得

End_Row = ActiveSheet.UsedRange.Rows.Count

'確認列の項目名/列位置取得

check_col = ActiveCell.Column

title_str = Cells(1, check_col).Value

adrs = Split(ActiveCell.Address, "$")(1)

'アクティブセルの右に列挿入　⇒　挿入列の一番上を選択

Columns(ActiveCell.Column + 1).Insert Shift:=xlToRight

Cells(1, ActiveCell.Column + 1).Select

'タイトル入力

Cells(1, ActiveCell.Column) = "文字数確認"

Cells(1, ActiveCell.Column).Interior.Color = RGB(31, 73, 125)

Cells(1, ActiveCell.Column).Font.Color = RGB(255, 255, 255)

'書式が「文字列」の横で実行した場合、書式設定が引き継がれてしまうので

'書式を「標準」に設定

Range(Cells(2, ActiveCell.Column), Cells(End_Row, ActiveCell.Column)).NumberFormatLocal = "G/標準"

'項目下2行目～最終行まで関数入力

'※RC[-1]：同じ行で1列左のセルを参照

Range(Cells(2, ActiveCell.Column), Cells(End_Row, ActiveCell.Column)) = "=LenB(Substitute(RC[-1], ""<BR>"", ""改""))"

'関数入力したセルの背景色変更

Range(Cells(2, ActiveCell.Column), Cells(End_Row, ActiveCell.Column)).Interior.Color = RGB(253, 233, 217)

'1行目にフィルタ

Rows("1:1").AutoFilter

'セル幅をタイトルに合わせて調整

Selection.Columns.AutoFit

Call 高速化設定_終了

'完了メッセージ

MsgBox adrs & "列 " & "『" & title_str & "』 ⇒" & " LENB列挿入"

End Sub

Private Sub 高速化設定_開始()

'ステータスバー・高速化設定

With Application

.DisplayStatusBar = True 'ステータスバー表示

.StatusBar = "" 'ステータスバー文言

.Calculation = xlCalculationManual '手動計算に

.ScreenUpdating = False '画面描画を停止

.EnableEvents = False 'イベントの連鎖反応を停止

End With

End Sub

Private Sub 高速化設定_終了()

'ステータスバー・高速化設定終了

With Application

.StatusBar = "" 'ステータスバー文言

.ScreenUpdating = True '画面描画を開始

.Calculation = xlCalculationAutomatic '自動計算に

.EnableEvents = True 'イベントの連鎖反応を再開

End With

End Sub

感想

ある時、後輩が
「俺が日々使っているものですが、ゆーしゃん先輩の役に立つならば」
とコードを共有して下さいました。
~~(後輩さん、ありがとうございます。新天地でも是非プログラムを活かして頑張って下さい~~！！！~~)~~

当初は「LENB関数入れるくらい、手動でも10秒くらいで出来るし、いらないんじゃ…」
と思ってしまいましたが…

いざ、使ってみると非常に便利で私にとって欠かせないマクロとなりました(笑)

一言に「対象の右列にLENB関数を入れる」といっても
「新規列挿入、項目名入力、LENB関数入力、挿入列に色設定…」
と意外と？手作業が多い内容でしたので、
本マクロのおかげで文字数調整のストレスを減らせました。

LENB関数に限らず、
指定列の右列に関数挿入
したい場合に役に立つコードだと思いますので、是非ともご参考下さい！