セル範囲のアドレスから列番号のみを取得するサブルーチンです。
返却値はモジュールレベル変数に格納しています。
Option Explicit
Option Base 1
'モジュールレベル変数
Dim lngSelectRows()
Sub getSelectRows(strAddress As String)
'------------------------------------------------------------------------------
' アドレス文字列を列番号に展開する
' getSelectRows ("$E$5:$E$8,$E$10,$E$12:$E$14")→ 配列 lngSelectRows(5,6,7,8,10,12,13,14)
'------------------------------------------------------------------------------
Const DebugFlag As Boolean = False 'デバッグ文出力フラグ
Dim i As Long
Dim strWork As String
Dim strRows As String
Dim AddressArray
Dim a As Variant
Dim lngComma As Long, s As Long, e As Long
Dim r As Long 'lngSelectRowsの添字
If DebugFlag = True Then Debug.Print "変換前"; strAddress
Erase lngSelectRows '列番号返却用配列(モジュールレベル変数)
'アドレス内の「$」と「アルファベット」を削除
strRows = ""
For i = 1 To Len(strAddress)
strWork = Mid(strAddress, i, 1)
If strWork = "$" Then
ElseIf Not strWork Like "*[!A-Z]*" = True Then
Else
strRows = strRows & strWork
End If
Next i
'残った文字列をカンマで区切って配列へ
If InStr(strRows, ",") > 0 Then
AddressArray = Split(strRows, ",")
Else
ReDim AddressArray(1)
AddressArray(1) = strRows
End If
'「:」を展開して、列番号を配列へ
r = 0
For Each a In AddressArray
If InStr(a, ":") > 0 Then
lngComma = InStr(a, ":")
s = Mid(a, 1, lngComma - 1)
e = Mid(a, lngComma + 1, Len(a) - lngComma)
For i = s To e
r = r + 1
ReDim Preserve lngSelectRows(r)
lngSelectRows(r) = i
Next i
Else
r = r + 1
ReDim Preserve lngSelectRows(r)
lngSelectRows(r) = CLng(a)
End If
Next a
'デバッグ文
If DebugFlag = True Then
For Each a In lngSelectRows
Debug.Print "変換後"; a
Next
End If
End Sub
