excel自身より上の空白でないセルの参照について

質問

お世話になります。
タイトルについて下図

A　　B
　　・
　　・
　　・
1　リンゴ
2　リンゴ
3　リンゴ
4　リンゴ

1　バナナ
2　バナナ
　バナナ
3　バナナ
　 バナナ
4　バナナ
　 バナナ
　 バナナ
x　バナナ
　　・　
　　・　
　　・

というエクセルの表がある場合、xのセルに、自身のセルより上のセルを1つずつ検索し、
初めて空でないセルにぶつかった場合、それに+1した値を挿入するという方法はありますでしょうか

宜しくお願い致します。

回答No.12

kkkkkm · ベストアンサー

とりあえず
選択した範囲でB列の先頭行の項目と一致しC列にデータがないA列のセルに連番を振ります。選択した範囲のB列に複数の項目が存在した場合、先頭行の項目に一致したものだけに連番を振ります。

Sub Test()
Dim TargetRow As Long, LastRow As Long
Dim TargetColumn As Long
Dim i As Long, j As Long
Dim mRange As Range
Dim FindStr As String

If Selection(1).Column <> 1 Then
MsgBox "A列を選択してください", vbInformation
Exit Sub
End If

If Selection(1).Value <> "" Then
MsgBox "既に値が入力されています", vbInformation
Exit Sub
ElseIf Selection(1).Offset(0, 1).Value = "" Then
MsgBox "選択したセルの右隣りのセルにデータがありません", vbInformation
Exit Sub
ElseIf Selection(1).Offset(0, 2).Value <> "" Then
MsgBox "選択したセルの2個右隣りのセルにデータがあります", vbInformation
Exit Sub
End If
TargetRow = Selection(1).Row
TargetColumn = Selection(1).Column
LastRow = Cells(Rows.Count, TargetColumn + 1).End(xlUp).Row
FindStr = Cells(TargetRow, TargetColumn + 1).Value
Set mRange = Range(Cells(1, TargetColumn + 1), Cells(LastRow, TargetColumn + 1)).Find(FindStr, LookAt:=xlWhole)
If Not mRange Is Nothing Then
mRange.Offset(0, -1).Value = 1
End If
For i = TargetRow - 1 To 1 Step -1
If Cells(i, TargetColumn).Value <> "" And _
Cells(TargetRow, TargetColumn + 1).Value = Cells(i, TargetColumn + 1).Value Then
Selection(1).Value = Cells(i, TargetColumn).Value + 1
Exit For
ElseIf i = 1 Then
Selection(1).Value = 1
End If
Next
j = 1
For i = TargetRow + 1 To Cells(Rows.Count, TargetColumn).End(xlUp).Row
If (i < TargetRow + Selection.Rows.Count Or Cells(i, TargetColumn).Value <> "") And _
Cells(i, TargetColumn + 2).Value = "" And _
Cells(TargetRow, TargetColumn + 1).Value = Cells(i, TargetColumn + 1).Value Then
Cells(i, TargetColumn).Value = Selection(1).Value + j
j = j + 1
End If
Next
End Sub

お礼

何度もありがとうございました。
助かりました。

回答No.1

hiodraiu

あります。
VBAで実現可能です。