文字列中の数字に指定値を加減算する
今回は文字列の途中(もしくは先頭や末尾)に存在する数字に、指定値を加減算させてみたいと思います。んで、ついでに指定値でインクリメント・デクリメントなんかもさせたい。
処理のイメージはこんなの。
欲を言えば、全角数字でも処理できるようにしたい。
ということで作りました。
Sub 文字中の数字に指定値を加減算する() '選択範囲に対して処理を行います '数字は半角・全角どちらでも処理可(漢数字は処理不可) '処理対象の数字の桁数を維持します Dim 零 As String Dim ns As Integer Dim ne As Integer Dim 値 As Long Dim tmp As Integer Dim myRange As Range Dim 数値 As Long Dim 数字 As String Dim 増量 As Long 零 = "000000000" ns = InputBox("左から何文字目を開始位置にしますか?") ne = InputBox("開始位置から何文字の数字を対象にしますか?") 値 = InputBox("加算する値を入力して下さい。" & vbCrLf & "(マイナスの値を入力すると減算になります)") tmp = MsgBox("入力した値で選択順にインクリメントしますか?", vbYesNo + vbDefaultButton2) For Each myRange In Selection.SpecialCells(xlCellTypeVisible) If myRange.Value <> "" And TypeName(myRange.Value) <> "Date" Then 'セルの値が空白,日付の場合は処理をしない 数値 = Mid(myRange.Value, ns, ne) 数値 = 数値 + 値 + 増量 If 数値 < 0 Then 数値 = 0 '減算した値が0未満の場合は0を下限とする If tmp = vbYes Then 増量 = 増量 + 値 'インクリメントする場合の処理 If Mid(myRange.Value, ns, ne) = StrConv(Mid(myRange.Value, ns, ne), vbWide) Then 数字 = StrConv(Right(零 & 数値, ne), vbWide) Else 数字 = Right(零 & 数値, ne) End If myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, ns, ne, 数字) End If Next myRange End Sub
※コードの使用方法
SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら。
プログラムの説明
- 割愛
課題
- 処理対象の数字が左から何文字目か・・・・・・等々をユーザーが入力する必要があり、めんどくさい(処理対象セルが数百あるなら些細な手間ですが)。
- 複数のセルを処理対象にするのなら、データの規則性(数字の位置・文字数 等々)が一致している必要がある。
- 漢数字やローマ数字は処理不可。
以下の記事では、オートフィルでカウントアップされなかった他の数値をカウントアップする方法を紹介しています。目的は少し異なりますが、私のものと違い、操作感はかなりスマートです。また、処理結果を元に戻すことが可能。