【excel vba】最大列位置を取得する
'**************************************************
'名称 :F_GetColMax 最大列位置を取得する
'引数 :robjSheet (I ) Worksheet
' :vlRowNo (I ) Long:KEYとなる行(あれば)
' :rlColMax ( O) Long:(返却用)最大列
' :rsMsg ( O) String:エラーメッセージ
'戻り値:True=成功, False=どこかでエラーになった
'作成 :Kinaccco
'**************************************************
Public Function F_GetColMax(ByRef robjSheet As Worksheet _
, Optional ByVal vlRowNo As Long = 0 _
, Optional ByRef rlColMax As Long = 0 _
, Optional ByRef rsMsg As String = "") As Boolean
On Error GoTo Sub_Err
Dim lbRet As Boolean
Dim lbHit As Boolean
Dim lobjURange As Range
Dim llColMax As Long
Dim llColMaxURange As Long
Dim llRowMaxURange As Long
Dim i As Long, j As Long
'--- 初期値セット ---
lbRet = False
rlColMax = 0
llColMax = 0
rsMsg = ""
'--- パラメータチェック ---
If robjSheet Is Nothing Then
rsMsg = "[ERR-01]Worksheet参照の受け渡しに失敗しました"
GoTo Sub_Exit
End If
'--- UsedRange取得 ---
Set lobjURange = robjSheet.UsedRange
'--- UsedRangeから最終行・最終列を取得する ---
llRowMaxURange = lobjURange.Row + lobjURange.Rows.Count - 1
llColMaxURange = lobjURange.Column + lobjURange.Columns.Count - 1
If vlRowNo = 0 Then
'--- 基準行が省略された場合、UsedRange最終行列から逆順に総なめ ---
lbHit = False
With robjSheet
For i = llColMaxURange To 1 Step -1
For j = llRowMaxURange To 1 Step -1
If Len(Trim(.Cells(j, i).Value)) > 0 Then
lbHit = True
llColMax = i
Exit For
End If
Next j
If lbHit Then Exit For
Next i
If lbHit = False Then
rsMsg = "[ERR-02]最終列の取得に失敗しました"
GoTo Sub_Exit
End If
End With
Else
'--- 基準行がUsedRange最終行より大きい場合エラーとする ---
If vlRowNo > llRowMaxURange Then
rsMsg = "[ERR-03]基準行に指定された値が正しくありません(最終行より大きい)"
GoTo Sub_Exit
End If
With robjSheet
If Len(.Cells(vlRowNo, llColMaxURange).Value) > 0 Then
'--- UsedRange最終列の基準行に値が入力されている場合、UsedRangeの最終列を返す ---
llColMax = llColMaxURange
Else
'--- UsedRange最終列の基準行が空白の場合、シート最終列から終端セルを返す ---
llColMax = .Cells(vlRowNo, .Columns.Count).End(xlToLeft).Column
End If
End With
End If
'--- 返却用変数に格納する ---
rlColMax = llColMax
'--- 正常終了 ---
lbRet = True
Sub_Exit:
On Error Resume Next
Set lobjURange = Nothing
F_GetColMax = lbRet
Exit Function
Sub_Err:
rsMsg = "予期せぬエラーが発生しました" & vbCrLf & _
"プロシージャ名:F_GetColMax" & vbCrLf & _
"エラー番号:" & Err.Number & vbCrLf & _
"エラー内容:" & Err.Description
GoTo Sub_Exit
End Function