Mid関数で文字を切り出すマクロ（ランチャー３）
2021年03月20日
前回、文頭および文末の文字を削除するマクロを作った。
ユーザーフォームで削除対象の文字を確認しながら
上下ボタンで文字数を設定できるUIが便利だった。
いつもMid関数で何文字目か調べるのがめんどくさいので、
Midで抜き出すバージョンを作ってみた。
基本的な作りは前回と全く同じ。
Leftの代わりにMidでSample文字を表示する仕様に変更。
文字数を指定しないとすぐに表示できないので、
文字数のデフォルト値を１０に設定した。
マクロで文字を確認してMid関数を使う方が多そう。
ダウンロード
プロパティは以下のとおり。
オブジェクト名：strMidForm（フォーム名）
Caption（表示名）：MID(selection,開始文字,文字数)
オブジェクト名：stPos '開始位置
TabIndex（タブ遷移の順番）：1
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
TextBoxに数字のみ入力させる 【VBA在庫管理#33】 | オレグラミング (oregramming.com)
オブジェクト名：Ln '文字数
TabIndex（タブ遷移の順番）：2
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
Value（デフォルト値）：10
オブジェクト名：CommandButton1 ’キャンセルボタン
Accelerator（操作キー Alt + ...）：C
Cancel（ESCキー紐づけ）：True
TabIndex（タブ遷移の順番）：4
オブジェクト名：CommandButton2 '実行ボタン
Accelerator（操作キー Alt + ...）：M
TabIndex（タブ遷移の順番）：3
オブジェクト名：SampleMid 'Mid後の文字サンプル表示
TabStop（タブ遷移の対象）：False
TextAlign（テキスト位置）：2 fmTextAlignCenter（中央揃え）
以下、ソース
ユーザーフォームで削除対象の文字を確認しながら
上下ボタンで文字数を設定できるUIが便利だった。
いつもMid関数で何文字目か調べるのがめんどくさいので、
Midで抜き出すバージョンを作ってみた。
基本的な作りは前回と全く同じ。
Leftの代わりにMidでSample文字を表示する仕様に変更。
文字数を指定しないとすぐに表示できないので、
文字数のデフォルト値を１０に設定した。
マクロで文字を確認してMid関数を使う方が多そう。
ダウンロード
プロパティは以下のとおり。
オブジェクト名：strMidForm（フォーム名）
Caption（表示名）：MID(selection,開始文字,文字数)
オブジェクト名：stPos '開始位置
TabIndex（タブ遷移の順番）：1
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
TextBoxに数字のみ入力させる 【VBA在庫管理#33】 | オレグラミング (oregramming.com)
オブジェクト名：Ln '文字数
TabIndex（タブ遷移の順番）：2
IMEMode（日本語入力制御）：2 (fmIMEModeOff) 英語モード
Value（デフォルト値）：10
オブジェクト名：CommandButton1 ’キャンセルボタン
Accelerator（操作キー Alt + ...）：C
Cancel（ESCキー紐づけ）：True
TabIndex（タブ遷移の順番）：4
オブジェクト名：CommandButton2 '実行ボタン
Accelerator（操作キー Alt + ...）：M
TabIndex（タブ遷移の順番）：3
オブジェクト名：SampleMid 'Mid後の文字サンプル表示
TabStop（タブ遷移の対象）：False
TextAlign（テキスト位置）：2 fmTextAlignCenter（中央揃え）
以下、ソース
（ユーザーフォーム表示は省略）
Sub strMidMain(stPos As Long, Ln As Long)
Dim r As Range
For Each r In Selection
If Left(r.Formula, 1) <> "=" Then
If Val(stLen) + Val(edLen) < Len(r) Then
r.Value = Mid(r.Value, stPos, Ln)
End If
End If
Next r
End Sub
Private Sub stPos_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case vbKeyReturn, vbKeyBack, vbKeyDelete, vbKeyTab
Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5, vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9
Case vbKeyLeft, vbKeyRight
Case vbKeyUp
If stPos = "" Then
stPos = 1
Else
stPos.Value = stPos + 1
End If
Case vbKeyDown
If stPos <> "" And stPos <> 0 Then
stPos.Value = stPos - 1
End If
KeyCode = 0
Case vbKeyEscape
Case Else
KeyCode = 0
End Select
End Sub
Private Sub stPos_change()
If Left(Selection(1).Formula, 1) <> "=" Then
If stPos.Value <> "" And stPos.Value <> 0 Then
If Ln.Value <> "" And Ln.Value <> 0 Then
SampleMid.Caption = Mid(Selection(1).Value, Val(stPos.Value), Ln.Value)
End If
End If
End If
End Sub
Private Sub Ln_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case vbKeyReturn, vbKeyBack, vbKeyDelete, vbKeyTab
Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9
Case vbKeyNumpad0, vbKeyNumpad1, vbKeyNumpad2, vbKeyNumpad3, vbKeyNumpad4, vbKeyNumpad5, vbKeyNumpad6, vbKeyNumpad7, vbKeyNumpad8, vbKeyNumpad9
Case vbKeyLeft, vbKeyRight
Case vbKeyUp
If Ln = "" Then
Ln = 1
Else
Ln.Value = Ln + 1
End If
Case vbKeyDown
If Ln <> "" And Ln <> 0 Then
Ln.Value = Ln - 1
End If
KeyCode = 0
Case vbKeyEscape
Case Else
KeyCode = 0
End Select
End Sub
Private Sub Ln_change()
If Left(Selection(1).Formula, 1) <> "=" Then
If stPos.Value <> "" And stPos.Value <> 0 Then
If Ln.Value <> "" And Ln.Value <> 0 Then
SampleMid.Caption = Mid(Selection(1).Value, Val(stPos.Value), Ln.Value)
End If
End If
End If
End Sub
Private Sub CommandButton1_Click() 'キャンセルボタン
'https://excel-ubara.com/excelvba3/EXCELFORM003.html
Unload Me
End Sub
Private Sub CommandButton2_Click() '実行ボタン
If stPos = "" Then Exit Sub
If Ln = "" Then Exit Sub
Call strMidMain(stPos, Ln)
Unload Me
End Sub
PR
Comment