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
--------------------------------------------
お礼
解決しました、ありがとうございました!