VBA 類似処理の件数を同様にする方法について

質問

ExcelVBAの初歩的な質問です。
【質問内容】
[CheckAcolumnBrank]と[CheckBcolumnBrank]の処理を行った際に、[CheckBcolumnBrank]の結果が[CheckAcolumnBrank]の結果と行数が異なるため（5行ほど多く処理されてしまいます）、[CheckAcolumnBrank]の行数に合わせるコードを知りたいです。

ご見識のある方からの、お知恵の拝借をいただきたく、よろしくお願い申し上げます。

【前提条件】
1.シート1のA5からJ500までの範囲のセルに値が入力されています（空欄セルが不規則にあります）。
2.レコード数は10行程度から450行程度です。
3.A列のセルに値が入っていない場合は、1つ上のセルの値をコピーする挙動です。
4.B列についても、A列と同じ挙動をさせたいです。
5.最終行を求める処理は「GetLastRow」にて行います。

--------------------------------------------
Function GetLastRow() As Long
' 最終行を求める処理
Dim i As Long
Dim MaxValue As Long

For i = 5 To 500
If Cells(i, "A").Value <> "" Then
' A列からJ列に入力されている値の最大値を求める
MaxValue = Application.WorksheetFunction.Max(Range("A" & i & ":J" & i))
If MaxValue > GetLastRow Then
GetLastRow = i
End If
End If
Next

End Function

--------------------------------------------

Private Sub CheckAcolumnBrank()
' A列がブランクの場合、1つ上の値をコピペする処理
Dim currentRow As Long
Dim emptyColumns As Boolean
Dim Lcont As Long

Lcont = GetLastRow

Dim ws As Worksheet
Set ws = Sheets("シート1")
emptyColumns = False
' A列を埋めるループ処理開始
currentRow = 6
Do While currentRow <= Lcont
If IsEmpty(ws.Cells(currentRow, 1).Value) Then
ws.Cells(currentRow, 1).Value = ws.Cells(currentRow - 1, 1).Value
End If
' 終了条件のチェック（E列からJ列がすべて空白、かつA列の1つ上の値が異なる場合に終了）
If ws.Cells(currentRow, 5).Value = "" _
And ws.Cells(currentRow, 6).Value = "" _
And ws.Cells(currentRow, 7).Value = "" _
And ws.Cells(currentRow, 8).Value = "" _
And ws.Cells(currentRow, 9).Value = "" _
And ws.Cells(currentRow, 10).Value = "" _
And (ws.Cells(currentRow, 1).Value <> ws.Cells(currentRow - 1, 1).Value) Then
Exit Do
End If
currentRow = currentRow + 1
Loop
End Sub

--------------------------------------------

Private Sub CheckBcolumnBrank()
' B列がブランクの場合、1つ上の値をコピペする処理
Dim currentRow As Long
Dim emptyColumns As Boolean
Dim Lcont As Long

Lcont = GetLastRow

Dim ws As Worksheet
Set ws = Sheets("シート1")
emptyColumns = False

' ループ開始
currentRow = 6
Do While currentRow <= Lcont
If ws.Cells(currentRow, 2).Value = "" Then
ws.Cells(currentRow, 2).Value = ws.Cells(currentRow - 1, 2).Value
End If
' 終了条件のチェック（E列からJ列がすべて空白、かつB列の1つ上の値が異なる場合に終了）
If ws.Cells(currentRow, 5).Value = "" _
And ws.Cells(currentRow, 6).Value = "" _
And ws.Cells(currentRow, 7).Value = "" _
And ws.Cells(currentRow, 8).Value = "" _
And ws.Cells(currentRow, 9).Value = "" _
And ws.Cells(currentRow, 10).Value = "" _
And (ws.Cells(currentRow, 2).Value <> ws.Cells(currentRow - 1, 2).Value) Then
Exit Do
End If
currentRow = currentRow + 1
Loop

Set ws = Nothing

End Sub

--------------------------------------------

回答No.11

kkkkkm

あと
回答No.3
のお礼の以下の部分

> A列かB列のデータ数が多いほうが範囲内での最大行と考えていた

に関して回答がないようなので、一例として

Lcont = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If Lcont < ws.Cells(ws.Rows.Count, "B").End(xlUp).Row Then
Lcont = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
End If

元のコードを利用するのでしたら

Function GetLastRow() As Long
' 最終行を求める処理
Dim i As Long

For i = 5 To 500
If Cells(i, "A").Value <> "" Or Cells(i, "B").Value <> "" Then
GetLastRow = i
End If
Next

End Function

回答No.10

kkkkkm

他の方の回答に付帯してとやかく言いたくはありませんが

差が出るのは
A列からJ列に入力されている値で最大値がある行が最終行(細かな説明は省いてましたが)としている点にあると思います。

実際は過去の最終行の行番号と現在行の最大値の大きい方が最終行
たとえば、最終行と仮定された行が200行目の時201行目以降で最大値が200を超えなければデータが存在しても最終行は200のまま
A列処理後元空欄だった180行が2回目で埋められて条件によって最終行と判断された場合、それ以降の行で最大値が180を超えなければ最終行は180のまま

という事もありますからデータによっては下にある行が必ずしも最終行として扱われるわけではありませんし、実際の最終行が取得できないという事もあり得ます。

ちなみに、A列を実行した時に空白のセルに上のセルの値を代入しますが最終行(最終行は空白では無いはず)までなので最終行より下にデータが埋められるという事は無いと思います。
2度目の最終行が上記の理由で上になることはあっても下になることはない思いますが、実際Aの後にBを実行してBの方が下になったのでしょうか。

回答No.9

chie65535

＞ちなみに、なぜ5件の差が生じる理屈が恥ずかしながらわかっておりません。

差が出る理由は
１．初回のGetLastRowでは、B～J列に何が入っていてもA列が空欄の行は無視され、それより上の行が最終行として判定される
２．CheckAcolumnBrankで、上記１で「A列が空欄で無視されていた行」のA列に、値がコピーされ、空欄では無くなる
３．２回目のGetLastRowでは、上記１で無視されていた行は、上記２の処理でA列が空欄ではなくなり、無視されなったため、上記１より下にある行が最終行として判定される
というのが理由です。

だから「GetLastRowを２回呼んではいけない」のです。

回答No.8

kkkkkm

とりあえずですが、A列からJ列に入力されている値で最大値がある行が最終行ではないという事ですので

最終行の取得で元のコードを利用するとしたら

Function GetLastRow() As Long
' 最終行を求める処理
Dim i As Long

For i = 5 To 500
If Cells(i, "A").Value <> "" Then
GetLastRow = i
End If
Next

End Function

回答No.7

kkkkkm

ちなみに最終行が正しければ、今回のコードでは最終行までしかループしてませんから、途中で最終行が変化することは無いと思いますよ。

回答No.6

kkkkkm

回答No.5で最後に抜けがありました。

たとえば、最終行に関してA列はA列の最後までB列はB列の最後まで操作を実施するのか、それともA列B列とも同じ行まで操作を実施するのかによって最終行の求め方も変わりますから何がいいのか悪いのかとか提案もできないということです。

回答No.5

kkkkkm

> 「GetLastRow」が正しく動いていないため、せっかくご提示いただいたにもかかわらず、行数がズレた結果となってしまいます。kkkkkmさんのコードは正しく動作すると思われますが、前段階で私のコードが誤っていることに起因しており、誠に申し訳ございません。

元のコードを引数付きにしただけなので行数が違う事については何もさわっていません。
と説明しているように行数のズレに関しては何もさわってませんからズレたままでしょう。

最終行が違うデータを基にしてあれこれ考えても無駄ですのでとりあえず最終行を取得するようにしてみたほうがいいと思いますよ。
ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

とかで求められたりしますが、他にも方法がありますから検索してご自身がこれと思うものを採用してください。

行数がずれたというのが何を基にしているのか分かりませんし、どのようなデータでどのような結果を期待してるのかもわかりませんから良いとか悪いとかは何とも言えませんし、こうするのですという提案もできないと思いますよ。

回答No.4

kkkkkm

No.1でちょっと説明下手だった所を補足

> A列からJ列に入力されている値の最大値が最終行なのですか？

A列からJ列に入力されている値で最大値がある行が最終行なのですか？

お礼

補足のご連絡ありがとうございます。

>> A列からJ列に入力されている値の最大値が最終行なのですか？
>A列からJ列に入力されている値で最大値がある行が最終行なのですか？
いえ、最大値が最終行ではございません。
と、kkkkkmさんからの上記ご連絡で、私が何を間違えていたかが気付けそうな予感がします……具体的な考えまで浮かぶほど私は賢くないので、時間がかかりそうですが。

お気にかけていただき、ありがとうございます。

回答No.3

chie65535

＞[CheckAcolumnBrank]と[CheckBcolumnBrank]の処理を行った際に、[CheckBcolumnBrank]の結果が[CheckAcolumnBrank]の結果と行数が異なるため

現状では、結果が異なる事を回避できません。

CheckAcolumnBrankを実行した後には「A列の状況が変わっている」つまり「今までブランクだったセルに、ブランクじゃない物がコピーされている」ので、CheckAcolumnBrankの中で呼び出しているGetLastRowの返り値と、CheckBcolumnBrankの中で呼び出しているGetLastRowの返り値は「異なる値」になります。

これを防ぐには「A列が手付かずの状態で求めた、GetLastRowの返り値の値を、どこかに記録しておいて、CheckAcolumnBrankとCheckBcolumnBrankの両方で、その記録しておいた値を使う」という事をしないとなりません。

言い換えると「GetLastRowを２回以上呼び出してはいけない」と言う事です。

ですので「根本的な部分から作り直す必要がある」と思われます。現状では回避不可能です。

「結果が正しいのであれば、異なる行数を実行してしまうのも仕方が無い」と諦めるか「GetLastRowを１回しか使わないように根本的な部分から作り直す」か、どちらかを選択して下さい。

なお、この考察を確かめたい場合は、
CheckAcolumnBrankの
Lcont = GetLastRow
の次の行に
msgbox "A=" & Lcount
と言う行を挿入し、同様に
CheckBcolumnBrankの
Lcont = GetLastRow
の次の行に
msgbox "B=" & Lcount
と言う行を挿入してみて下さい。

きっと
A=493
B=498
のように「AとBで異なる値が表示される筈」です。

ここで異なる値が表示される限り、AとBで実行される行数が異なるのは、絶対に避けられません。

お礼

ご回答ありがとうございます。また、お礼が遅くなり大変恐縮でございます。
>言い換えると「GetLastRowを２回以上呼び出してはいけない」と言う事です。
そういうことなんですね。最終行を求める処理が2回あったので、プロシージャ化すれば便利かと思っていたのですが……。

chie65535さんから、ご提案いただいた通り、Msgboxで各々のプロシージャで変数の値を確認したところ、AとBで異なる値が表示されました。件数の差は、chie65535さんが例示された通りBの方が「5件」多かったです。誠に恐れ入りました。

ちなみに、なぜ5件の差が生じる理屈が恥ずかしながらわかっておりません。と申しますのは、A列とB列以外の列に存在するデータ数は、A列とB列に比べ少ないため、私としてはA列かB列のデータ数が多いほうが範囲内での最大行と考えていたのですが、実際はB列の方がA列よりもデータ数が5こ多くなる仕組みがわかりません。自分で作った仕組みの落ち度がわからないという情けない状況です。

もしよろしければ、上記の現象を言い当てた、chie65535さんのご知見を仰げると幸いです。

以上、よろしくお願い申し上げます。

回答No.2

kkkkkm

あと、余計なお世話だと思いますが、二つの処理はA列とB列の違いだけであとは全く同じだと思いますから、引数のあるサブプロシージャにしたら修正したりする場合に二つ同じように直さなくていいので楽になると思います。元のコードを引数付きにしただけなので行数が違う事については何もさわっていません。

Sub Test()

Call CheckcolumnBrank(Columns("A").Column)
Call CheckcolumnBrank(Columns("B").Column)

End Sub

Private Sub CheckcolumnBrank(ByVal mCol As Long)
' 指定列がブランクの場合、1つ上の値をコピペする処理
Dim currentRow As Long
Dim emptyColumns As Boolean
Dim Lcont As Long

Lcont = GetLastRow

Dim ws As Worksheet
Set ws = Sheets("シート1")
emptyColumns = False 'これの意味が分かりません。

' ループ開始
currentRow = 6
Do While currentRow <= Lcont
If ws.Cells(currentRow, mCol).Value = "" Then
ws.Cells(currentRow, mCol).Value = ws.Cells(currentRow - 1, mCol).Value
End If
' 終了条件のチェック（E列からJ列がすべて空白、かつ指定列の1つ上の値が異なる場合に終了）
If ws.Cells(currentRow, 5).Value = "" _
And ws.Cells(currentRow, 6).Value = "" _
And ws.Cells(currentRow, 7).Value = "" _
And ws.Cells(currentRow, 8).Value = "" _
And ws.Cells(currentRow, 9).Value = "" _
And ws.Cells(currentRow, 10).Value = "" _
And (ws.Cells(currentRow, mCol).Value <> ws.Cells(currentRow - 1, mCol).Value) Then
Exit Do
End If
currentRow = currentRow + 1
Loop

Set ws = Nothing

End Sub

お礼

再び、ご回答ありがとうございます。
>emptyColumns = False 'これの意味が分かりません。
ご指摘の通り、無意味なコードでした。試行錯誤しながら書いていたため、残骸を放置したままでした。

コードのご提案もいただき、重ねて御礼申し上げます。
先のご回答に対する御礼で申し上げましたが、「GetLastRow」が正しく動いていないため、せっかくご提示いただいたにもかかわらず、行数がズレた結果となってしまいます。kkkkkmさんのコードは正しく動作すると思われますが、前段階で私のコードが誤っていることに起因しており、誠に申し訳ございません。

kkkkkmさんから、新たな視点をいただき感謝しております。

以上、よろしくお願い申し上げます