空腹おやじのログと備忘録

VBA(主にExcel)でいろいろな実験的な事とか、Linuxのコマンドとか設定とかについて忘れないように、あれこれと・・・

【VBA】9桁以上の16進数表記文字列同士のORを求める

昨日、Twitter で、
「16進数のORをとるのにもっと効率のいいやり方ある?」
というやつを見つけました。

スマホの小さい画面で見ていたので、
実は細かいところまでは見えなかった(見てなかった?)ので
「単純にLongに変換して、OR とって、Hex で16進表記に戻せばいいのでは」と
返したら、どうも4Byte超相当(9桁以上)の文字列を処理したいらしい。

32bit版では Long(16進数表記で8桁)までしか処理できないので、
8桁ずつループ処理するコードを書いてみました。

なお、Twitter で返したコードを少し変えてあります。

Public Function HexStringOr(ByVal sHexValue1 As String, ByVal sHexValue2 As String) As String

    Dim lLen1       As Long
    Dim lLen2       As Long
    Dim lResultLen  As Long
    Dim lOrgLen     As Long
    Dim sHexW1      As String
    Dim sHexW2      As String
    Dim sResult     As String
    Dim lStartPos   As Long
    Dim lHex1       As Long
    Dim lHex2       As Long
    Dim lHexW       As Long
    Dim i           As Long

    Const ZERO8 As String = "00000000"

    '16進文字列判定
    If isHexString(sHexValue1) = False Then
        Exit Function
    ElseIf isHexString(sHexValue2) = False Then
        Exit Function
    End If

    lLen1 = Len(sHexValue1)
    lLen2 = Len(sHexValue2)

    If lLen1 >= lLen2 Then
        lOrgLen = lLen1
    Else
        lOrgLen = lLen2
    End If

    '8の倍数となる文字列長を求める
    lResultLen = ((lOrgLen + 7) \ 8) * 8

    'ゼロパディング
    sHexW1 = String$(lResultLen - lLen1, "0") & sHexValue1
    sHexW2 = String$(lResultLen - lLen2, "0") & sHexValue2

    '結果格納用文字列(ダミー0埋め)
    sResult = String$(lResultLen, "0")

    For i = 1 To lResultLen \ 8
        '処理先頭位置
        lStartPos = 1 + (i - 1) * 8

        '8文字抜き出してLongに変換
        lHex1 = CLng("&H" & Mid$(sHexW1, lStartPos, 8))
        lHex2 = CLng("&H" & Mid$(sHexW2, lStartPos, 8))

        lHexW = lHex1 Or lHex2

        '結果を格納
        Mid$(sResult, lStartPos, 8) = Right$(ZERO8 & Hex(lHexW), 8)
    Next i

    '元のデータの桁に合わせてから返す
    HexStringOr = Right$(sResult, lOrgLen)

End Function

'16進文字列判定
Private Function isHexString(ByVal sValue As String) As Boolean

    If Len(sValue) = 0 Then
        Exit Function
    End If

    isHexString = Not sValue Like "*[!0-9a-fA-F]*"

End Function


実行サンプル

? HexStringOr("1234567890ABCDEF11","22222222")
1234567890ABEFEF33

? HexStringOr("444444442222222200001122","1111222200008888CCCC3333")
555566662222AAAACCCC3333

? HexStringOr("004444444422222222000011","001111")
004444444422222222001111


「これで(速度的な意味で)効率が良くなったのか?」と聞かれれば、もちろん
「ほとんど変わらないよ!!!」
と言っちゃいます。m(_ _)m

パラメータの文字列が、数千桁とか数万桁なら、こっちの方が若干速いような気がしますけど。

最後に

今回のように、生成される文字列長が予め分かっているような場合には、
都度、文字列を結合するより、
予め、結果の文字列長のダミー文字列を用意しておいて、
それに対して、MidステートメントMid関数ではありません)で埋め込んでいったほうが効率的です。

左辺にMidがあるのは、見慣れないかもしれませんが、
覚えておくと便利です。

docs.microsoft.com

docs.microsoft.com

【VBA】Excelで、ひとつ上の可視セルの値を取得して貼り付けする

Excelでフィルタの適用状態に関わらず、任意のセルの(見た目上の)ひとつ上のセルの値を取得しようというもの。

元ネタはこちら
koroko.hatenablog.com
別の方法で、こちらでも。
infoment.hatenablog.com

両者とは別のアプローチで・・・

目次

抑えておくべき事

Range.Areasオブジェクト

MSのサイトより抜粋。

選択範囲内にある領域 (隣接しているセルのブロック) のコレクションです。

Areasコレクションの各メンバーは、 Range オブジェクトです。 Areasコレクションには、選択範囲内の各セルの不連続な連続した範囲のrangeオブジェクトが1つ含まれています。 選択範囲に領域が1つしか含まれていない場合、 Areasコレクションには、その選択範囲に対応するRangeオブジェクトが1つだけ含まれます。

https://docs.microsoft.com/ja-jp/office/vba/api/excel.areas

Rangeオブジェクトは、Range("A1:C3") といった指定をした場合のように、単一の矩形領域の場合だけでなく
Rrange("A1:C3,D2:F4")とか、Unionメソッドにより複数の矩形領域を纏めてひとつのRangeオブジェクトとして扱ったりする場合もあります。
それらの1個以上の矩形領域をCollectionとして纏められたものが、Range.Areasオブジェクトです。

Itemプロパティ

Areasオブジェクトに含まれているひとつの要素(Rangeオブジェクト)を返すプロパティです。

構文
Areas.Item(Index)

パラメーター

名前 必須/オプション データ型 説明
Index 必須 Long オブジェクトのインデックス番号を指定する。

省略記法
Areas(Index)
という記述でも同様に処理できます。

Countプロパティ

Areasコレクションに含まれるオブジェクトの数を返すプロパティです。
これにより前述のItemプロパティに指定できるインデックスの上限値がわかります。
構文
Areas.Count

実際の例

領域が分かれることで、Areas.Countが増え、それぞれの要素(Rangeオブジェクト)の情報(下の例ではAddress)を取得できています。
f:id:Z1000S:20190915101422j:plain

フィルターを使用している場合

フィルター適用前の状態が下図の要なデータで見てみる。
f:id:Z1000S:20190915104847j:plain

C列のデータを選択した状態
f:id:Z1000S:20190915104858j:plain

B列をDDで抽出した状態
f:id:Z1000S:20190915105629j:plain
SpecialCells(xlCellTypeVisible)を指定しないと、非表示のセルも含まれてしまう。
SpecialCells(xlCellTypeVisible)を指定することで、可視セルのみを対象としている。
また、非表示セルが間に入ると、Areasオブジェクト内のItemプロパティで取得する領域が別々になっている

処理

考え方

  1. 上記のフィルター適用時の結果から、基準となるセルの上の全てのセルのうち、表示されているセルと、基準のセルをUnionで纏める。
  2. 基準となるセルは、Unionで纏めたRangeの一番下なので、Areas.Item(Areas.Count) にある。
  3. Areas.Item(Areas.Count).Rows.Count が1ならば、基準セルのひとつ上のセル(見た目ではなく実際の1行上のセル)は非表示なので、Areas.Item(Areas.Count-1) の一番下のセルが求めるセル。
  4. Areas.Item(Areas.Count).Rows.Count が2以上なら、基準セルの1行上のセルは表示されているので、基準セルの1行上のセルが求めるセル。

コード

取得データ貼り付け処理

データ取得処理

コードをコピーしたい方へ

いつもの通り、コードはダブルクリックすれば選択できますので・・・

使い方

pasetFromAboveCellsValueをイミディエイトウィンドウから呼ぶなり、
適当なボタンに登録するなり、使いやすいようにして下さい。

実行サンプル

f:id:Z1000S:20190915123340g:plain

最後に

今回は、前回のやつがあったから気がつけた。
ちょっと満足。

z1000s.hatenablog.com

貼り付けだけが目的であれば、プロシージャを分けずに1つにした方が
無駄なコピーが無くせるので、スッキリするかも。



単一のセルだけでなく、複数のセルに対応したのと
データの途中の行でも実行可能なので、少しは使えるか?

【VBA】ExcelのUnionで纏められたRangeの Areas.Count と Areas.Item(N)

初めに

以前の記事で、Union メソッドで纏められた Range へのアクセス方法を書きました。
z1000s.hatenablog.com

その中で、

今回の場合、
赤で囲まれた範囲がArea(1)
青で囲まれた範囲がArea(2)
となり、
r.Areas(1).Address(False, False)は
B2:D4
r.Areas(2).Address(False, False)は
F3:G4
が返ります。
Unionで指定した順番に返ってくるようです。(そうでないと困ります。)

と書いたのですが、このようにならない場合があることがわかりました。

Union メソッドで、複数のRange を纏めた時、

項目
Areas.Item(N) 指定した個々の Range
Areas.Count 指定した Range の数

となるものと思い込んでいたのですが、そうならない場合があるようです。

また、Union メソッドの実行方法によっては、対象となる範囲が同じでも、Areas.Countや、Areas.Item( N ).Address が変わる場合があることがある事がわかりました。

Union メソッド

まず、改めて Union メソッドについて。
docs.microsoft.com

機能

2 つ以上のセル範囲の集合を返します

構文
expression.Union (Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
パラメータ
名前 必須/オプション データ型 説明
Arg1 必須 Range
Arg2 必須 Range
Arg3~Arg30 省略可 Range 範囲を指定する
戻り値

Range

使用例

基本的な使い方は、多分以下の2通りと思われます。

対象となる Range の数が固定の場合は、このような書き方ができます。

    Set r = Union(r1, r2, r3, r4)

一方で、対象となる Range が可変の場合や、ループ処理により纏めたいような場合には、こちらの方法が使いやすいと思います。

    Set r = Union(r1, r2)
    Set r = Union(r, r3)
    Set r = Union(r, r4)

他にも、このような書き方も出来ますが、多分ほとんど使われることはないかと思います。

    Set r = Union(Union(Union(r1, r2), r3), r4)

3番目の書き方は、最初の書き方を冗長にしただけのように見えますが、実はそうではありません。
(この件については、後述)

Areas.Count と Areas.Item(N)

実際に返ってくる値
項目
Areas.Item(N) パラメータで指定した1個以上の Range の纏まり
Areas.Count 以上 指定した Range の数以下
Areas.Item(N)

コレクションから単一のオブジェクトを返します。

https://docs.microsoft.com/ja-jp/office/vba/api/excel.areas.item

MSのサイトには、下記のような記述があります。

コレクションから単一のRangeオブジェクトを取得するのにには、 Areas (index) を使用します。_引数 index_には、area インデックス番号を指定します。 インデックス番号は、領域が選択された順序に対応します。

https://docs.microsoft.com/ja-jp/office/vba/api/excel.areas

基本的には、この通りになるようなのですが、例外があります。

Union メソッドに指定する Range が、以下のような場合、Areas.Item(N) は、複数の Range を纏めた範囲になります。つまり、パラメータで指定された複数の Range が、ひとつの Areas.Item(N) に纏まってしまう場合があります。

任意の複数の Range の集まりが矩形となる」場合に、
ひとつの Areas.Item(N) として纏まるようです。
その場合、領域が選択された順序と一致しない場合があります

Areas.Count

コレクションに含まれるオブジェクトの数を表す長整数型 (Long) の値を返します。

https://docs.microsoft.com/ja-jp/office/vba/api/excel.areas.count

ここで注意すべきは、
コレクションに含まれるオブジェクトの数
であって、
パラメータで渡した( Range )オブジェクトの数
ではないということです。

前述の通り、パラメータで指定した複数の Range が、ひとつの Areas.Item に纏められる場合、Areas.Count は、それに伴い パラメータの Range 数より少なくなることになります。

Range("A1") から Range("A30") までの30個の Range を Uniono で纏めると

Set r = Union( Range("A1"), Range("A2"), ・・・, Range("A30") )

纏められた Range r は、

Areas.Count
Areas.Item(1).Address A1:A30
Areas.Address A1:A30

となります。

複数の Range がひとつの Areas.Item( N ) に纏められるケース(具体例)

Union( r1, r2, r3 )

の記述で、纏めてみた結果が下の図です。
下図のA列にアドレス単独で表示されているものは、Union メソッドに渡した Range であり、Union メソッドには、上から順に渡しています。

なお、下図の中の Areas.Address: の後ろに表示されている [ ] で囲まれたそれぞれの部分が Areas.Item( N ) .Address です。

隣接する2個以上の Range が矩形となる場合

Unionに指定するRangeの順番の影響は見られません。
f:id:Z1000S:20190826215154j:plain

2個以上の Range の一部が重なるが、全体が矩形となる場合

重なっている部分を含め、全体がひとつのAreas.Item( N ) となります。
f:id:Z1000S:20190826215813j:plain

Range A に、Range B が含まれる場合

サイズが、基準となる(大きい方の)Range以下の Range は無視されています。
f:id:Z1000S:20190826220225j:plain

対象範囲が同じでも結果が変わる例

記述の違い(実行方法の違い)によるもの

前述の通り、Union メソッドの書き方は、思いついただけで3パターンあります。

同じ Range を、同じ順番でメソッドに渡しても、返ってくる結果が異なる場合を見つけました。

Range r1、r2、r3 を以下の範囲とします。

変数 Range
r1 Range("D4:E5")
r2 Range("D2:E3")
r3 Range("B2:C3")

これらの範囲を使用して、以下の式が返す結果を比較してみます。

No.
1 Set r = Union(r1, r2, r3)
2 Set r = Union(r1, r2)
Set r = Union(r, r3)
3 Set r = Union(Union(r1, r2), r3)


No.1 のみが、他と結果が異なっているのがわかります。
No.1 が、r2r3 が纏まっているのに対し、
No.2とNo.3は、r1r2 が纏まっています。

No.Areas
.Count
Areas
.Item(1)
.Address
Areas
.Item(2)
.Address
1Set r = Union(r1, r2, r3)2D4:E5B2:E3
2Set r = Union(r1, r2)
Set r = Union(r, r3)
2D2:E5B2:C3
3Set r = Union(Union(r1, r2), r3)2D2:E5B2:C3

f:id:Z1000S:20190828114105j:plain
No.1 Union( r1, r2, r3 )
f:id:Z1000S:20190828114245j:plain
No.2 Union( r1, r2 ) + Union( r, r3 )
f:id:Z1000S:20190828114419j:plain
No.3 Union( Union( r1, r2 ), r3 )

No.2、No.3では、順次Unionメソッドで Range を纏めているため、その都度 Areas.Item( N ) が更新されていくため、このような結果になると考えられます。

Union メソッドに渡すパラメータの順番による違い
変数 Range
r1 Range("B2:C3")
r2 Range("D2:E3")
r3 Range("B4:C5")

として、
Union( Arg1, Arg2, Arg3 ) と呼び出してみました。

No. Arg1 Arg2 Arg3
1 r1 r2 r3
2 r3 r2 r1

f:id:Z1000S:20190828141736j:plain
No.1 Union( r1, r2, r3 )
f:id:Z1000S:20190828154234j:plain
Union( r3, r2, r1 )
No.1 では、縦方向に纏まっていますが、
No. 2 では、横方向に纏まっています。

コード(抜粋)

コードが欲しい方は、コードをダブルクリックすると、少しだけいいことがあるかもしれません

データ設定、描画処理呼び出し

描画処理

その他

最後に

処理方法によって結果が変わる場合があるのは分かった。
キーワードは、矩形

しかし、Union( r1, r2, ・・・, rn ) の場合の規則性が分からん。

Areas.Item( N ).Address が変わって困るような処理は今の所ないから、
今回はここまでで勘弁してやろう・・・ orz






m(_ _)m

【VBA】偶数判定、奇数判定

主に偶数判定のための私的メモ。

判定結果
偶数の場合奇数の場合
偶数判定( N Eqv 0 ) And 101
( N And 1 ) = 0TrueFalse
奇数判定N And 101
( N And 1 ) = 1TrueFalse


Eqv(XOr の逆パターン)

値1 値2 値1 Eqv 値2
False False True
False True False
True False False
True True True


Bit版

値1 値2 値1 Eqv 値2
0 0 1
0 1 0
1 0 0
1 1 1


整数版

値1 値2 値1 Eqv 値2
0 0 -1 (&HFFFF)
0 1 -2 (&HFFFE)
0 2 -3 (&HFFFD)
1 0 -2 (&HFFFE)
2 0 -3 (&HFFFD)
&HFFFF 0 0
&HFFFF 1 1
&HFFFF 2 2
&HFFFF 3 3
&HFFFE 0 0
&HFFFE 1 0
&HFFFE 2 3
&HFFFE 3 2

【VBA】同じデータのセルを結合(Union未使用版)

下記のサイトで、同じデータのセルを結合するということで、Unionを使ってRangeをまとめて最後にMergeという処理を行っていました。

kouten0430.hatenablog.com

これはこれで良いのですが、非連続データならともかく、連続データである場合には、
個人的には、「何度もUnionせずに、範囲(開始行と終了行)を取得してMerge」とする方が好みなので、作ってみました。

Do Until の2重ループにして、以下のようなソースに。
(縦方向のマージ処理のみです)

外側のループで、基準となる行を進めていって、
内側のループで、基準となる値が終わる行を取得しています。

Public Sub doMerge()

    Dim r   As Range

    Set r = Sheet1.Range("A1").CurrentRegion
    Set r = r.Resize(r.Rows.Count - 1).Offset(1)

    Call MergeSameValueCellsV(r)

    Debug.Print "Done."

End Sub


Private Sub MergeSameValueCellsV(ByRef rTarget As Range)

    Const TARGGET_COL   As String = "A"

    Dim ws              As Worksheet
    Dim lCurrentRow     As Long
    Dim lNextRow        As Long
    Dim lEndRow         As Long
    Dim lMergeBeginRow  As Long
    Dim lMergeEndRow    As Long
    Dim vBaseValue      As Variant

    If rTarget Is Nothing Then
        Exit Sub
    ElseIf rTarget.Rows.Count = 1 Then
        Exit Sub
    End If

    Application.DisplayAlerts = False

    lCurrentRow = rTarget.Row
    lEndRow = rTarget.Row + rTarget.Rows.Count - 1

    Set ws = rTarget.Parent

    Do Until lCurrentRow > lEndRow

        lMergeBeginRow = lCurrentRow
        lMergeEndRow = lMergeBeginRow

        vBaseValue = ws.Range(TARGGET_COL & CStr(lCurrentRow)).Value

        lNextRow = lMergeBeginRow + 1

        Do Until vBaseValue <> ws.Range("A" & CStr(lNextRow)).Value
            lMergeEndRow = lNextRow

            lNextRow = lNextRow + 1
        Loop

        If lMergeEndRow > lMergeBeginRow Then
            'マージ開始行と終了行が違っていたら、マージ処理
            ws.Range(TARGGET_COL & CStr(lMergeBeginRow) & ":" & TARGGET_COL & CStr(lMergeEndRow)).Merge

            '次の処理は、マージした次の行から
            lCurrentRow = lCurrentRow + lMergeEndRow - lMergeBeginRow + 1
        Else
            'マージしないので次の行
            lCurrentRow = lCurrentRow + 1
        End If
    Loop

    Application.DisplayAlerts = True

End Sub



今日は(も?)、人のネタを元にする日・・・

【VBA】種目別に自動採番(別解)

コロ子さん(id:SNegishi)のところで、自動採番処理をやっているのを見て、ちょっと気がついた点をコメントしました。
すぐに修正版がアップされて「おぉ~、仕事はえぇなぁ」と感心していました。
koroko.hatenablog.com


そんな中で、

「Worksheet_SelectionChangeイベントで変更前の値を保持しておいく」のところを静的変数Staticを使おうとしたけど、モジュール変数として使う事がでなかった。
「プローシシャーの外では使えません」のエラーメッセージが出た。
結局上手くできず、いつもの仮置き方式。
仮置き方式でないなら、どのように作るものなのでしょうか・・・?

多分、Worksheet_SelectionChangeの中にStatic変数を置いちゃったんでしょうね。
そのままでは、他のプロシージャからは、そのStatic変数にはアクセス出来ないので、
もう少し工夫が必要ですね。

私の場合、Static変数はほとんど使うことがなくて、大抵の場合、モジュールレベルのPrivate変数で処理しちゃいます。

下記のソースの vPrevValue_ がそれに当たります。
そいつに、Worksheet_SelectionChangeイベントで、必要な条件に一致した時に値を突っ込みます。

あと、Application.EnableEvents で処理中のイベントを抑止してあげないと、不要な処理が走るようです。


あと、先頭部分で処理不要なら、即 Exit Sub するように
以下の理由により、変えてあります。

  • それ以降、何も処理が無いのが明確になる
    • If でくくった場合、「Ifの後に何か処理があるかもしれない」ので確認が必要。プロシージャが長いほど、スクロールが面倒くさい(私の場合)
  • If によるインデントが不要になる


Private変数を使って処理したソースがこれ

Private vPrevValue_    As Variant


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim buf As Range

    If Target.Column <> 1 Then
        '1列目(A列)以外でイベントが発生した場合は、処理を抜ける
        Exit Sub
    ElseIf vPrevValue_ = Target.Value Then
        'データが変わっていなければ、処理を抜ける
        Exit Sub
    End If


    Application.ScreenUpdating = False
    Application.EnableEvents = False


    '初期化
    Range("B" & Target.Row).Value = ""

    'A列でフィルタ
    Range("A1").AutoFilter Field:=1, Criteria1:=Range("A" & Target.Row).Value

    'アクティブセル領域の可視範囲を取得
    Set buf = Range("A1").CurrentRegion.Columns(2).SpecialCells(xlCellTypeVisible)

    '最大値+1を取得
    Range("B" & Target.Row).Value = Application.WorksheetFunction.Max(buf) + 1

    'フィルター条件解除
    ActiveSheet.ShowAllData


    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    '複数セルを選択している中に、未入力セルが含まれていても処理できるように
    'Target.Count = 1
    'は含めない

'    If Target.Column = 1 And Target.Count = 1 Then
    If Target.Column = 1 Then

        '複数のセルが選択されている場合、Target.Valueを代入すると、
        'vPrevValueは配列になるのでActiveCellを指定する

'        vPrevValue_ = Target.Value
        vPrevValue_ = ActiveCell.Value
    End If

End Sub

【VBA】特定の範囲内の任意の整数をインクリメント、デクリメントして次の値を求める

条件

  • 任意の3つの整数において、以下の条件を満たす事(負の値があっても可)
    • 最小値 <= 現在値 <= 最大値
  • 範囲の最大値をインクリメントした場合、範囲の最小値を返す事。
  • 範囲の最小値をデクリメントした場合、範囲の最大値を返す事。

求める式

インクリメント、デクリメントというからには、普通に考えれば増減値は1なので、以下のようになる。

要素数 = 最大値 - 最小値 + 1

'インクリメントする場合
次の値 = ( ( 現在値 + 1 - 最小値 ) Mod 要素数 ) + 最小値

'デクリメントする場合
次の値 = ( ( 現在値 + ( 要素数 - 1 ) - 最小値 ) Mod 要素数 ) + 最小値
補足

インクリメントの場合
現在値に1を加算し、要素数の剰余を利用する。
範囲の最小値が0でない場合、最小値を0に補正して剰余を求めた後、補正した分を戻す。

デクリメントの場合
インクリメントでは、要素数に1を加算したが、デクリメントの場合は、
(要素数 - 1 )を加算し、同様に計算する。

増減値が2以上の場合、前述の式の1の部分を変えれば良い。

要素数 = 最大値 - 最小値 + 1

'インクリメントする場合
次の値 = ( ( 現在値 + 加算する値 - 最小値 ) Mod 要素数 ) + 最小値

'デクリメントする場合
次の値 = ( ( 現在値 + ( 要素数 - 減算する値 ) - 最小値 ) Mod 要素数 ) + 最小値

ただし、以下の条件を満たす必要がある。

加算する値 >= 0
減算する値 >= 0
かつ
減算する値 <= 要素数

コード

Private Const ERROR_INVALID_PARAMETER   As Long = 87


Public Function incrementBetweenNM(ByVal lCurrentValue As Long, _
                                   ByVal lMinValue As Long, _
                                   ByVal lMaxValue As Long, _
                          Optional ByVal lOffsetValue As Long = 1) As Long

    Dim lElements   As Long

    If lMinValue > lMaxValue Then
        Err.Raise ERROR_INVALID_PARAMETER
    ElseIf lMaxValue < lCurrentValue Then
        Err.Raise ERROR_INVALID_PARAMETER
    ElseIf lMinValue > lCurrentValue Then
        Err.Raise ERROR_INVALID_PARAMETER
    End If

    If lOffsetValue < 0 Then
        Err.Raise ERROR_INVALID_PARAMETER
    ElseIf lOffsetValue > lMaxValue - lMinValue + 1 Then
        Err.Raise ERROR_INVALID_PARAMETER
    End If

    lElements = lMaxValue - lMinValue + 1

    incrementBetweenNM = ((lCurrentValue + lOffsetValue - lMinValue) Mod lElements) + lMinValue

End Function

Public Function decrementBetweenNM(ByVal lCurrentValue As Long, _
                                   ByVal lMinValue As Long, _
                                   ByVal lMaxValue As Long, _
                          Optional ByVal lOffsetValue As Long = 1) As Long

    Dim lElements   As Long

    If lMinValue > lMaxValue Then
        Err.Raise ERROR_INVALID_PARAMETER
    ElseIf lMaxValue < lCurrentValue Then
        Err.Raise ERROR_INVALID_PARAMETER
    ElseIf lMinValue > lCurrentValue Then
        Err.Raise ERROR_INVALID_PARAMETER
    End If

    If lOffsetValue < 0 Then
        Err.Raise ERROR_INVALID_PARAMETER
    ElseIf lOffsetValue > lMaxValue - lMinValue + 1 Then
        Err.Raise ERROR_INVALID_PARAMETER
    End If

    lElements = lMaxValue - lMinValue + 1

    decrementBetweenNM = ((lCurrentValue + (lElements - lOffsetValue) - lMinValue) Mod lElements) + lMinValue

End Function

実行例

テストコード
Public Sub getNext()

    Dim l As Long
    Dim u As Long
    Dim i As Long

    l = -3
    u = 2

    Debug.Print "最小値:" & l
    Debug.Print "最大値:" & u
    Debug.Print ""

    Debug.Print "現在値", "次の値", "前の値"

    For i = l To u
        Debug.Print i, incrementBetweenNM(i, l, u), decrementBetweenNM(i, l, u)
    Next

End Sub
実行結果
call getNext
最小値:-3
最大値:2

現在値        次の値        前の値
-3            -2             2 
-2            -1            -3 
-1             0            -2 
 0             1            -1 
 1             2             0 
 2            -3             1 

おまけのテスト その1

call getNext
最小値:1
最大値:1

現在値        次の値        前の値
 1             1             1 

最大値 = 最小値 だと、次の値も前の値も、みんな同じ・・・
あたりまえか。

おまけのテスト その2

Debug.Print i, incrementBetweenNM(i, l, u, 2), decrementBetweenNM(i, l, u, 3)

として、加算、減算する値を変えてみると

call getNext
最小値:-3
最大値:2

現在値        次の値        前の値
-3            -1             0 
-2             0             1 
-1             1             2 
 0             2            -3 
 1            -3            -2 
 2            -2            -1