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.11

kkkkkm

> 複数のセルを選択した状態での実行にあたり、
> 型が一致しませんとのエラーが出てしまうのですが、

最初にxのセルという事で複数のセルで実行するとは考えていませんのでエラーになると思います。

複数のセルを選択してそこに全て番号(連番)を振るということですか？
あとから、仕様を変更されると・・・。

補足

>複数のセルを選択してそこに全て番号(連番)を振るということですか？
仰る通りです。
＞あとから、仕様を変更されると・・・。
大変申し訳ありません。
当方あまり詳しくないもので、複数に適応できると軽く見ていました。
大変申し訳ございません。

回答No.10

kkkkkm

> もし可能であれば下図のようにC列が空白の場合に、
> 数字を自動的に振り分ける方法を教えていただけますでしょうか。

選択した行のC列にデータがある場合は操作を実行しないとう考えだとしたら

最初の方にある

If Selection.Value <> "" Then
MsgBox "既に値が入力されています", vbInformation
Exit Sub
ElseIf Selection.Offset(0, 1).Value = "" Then
MsgBox "選択したセルの右隣りのセルにデータがありません", vbInformation
Exit Sub
End If

上記の部分を以下のようにしてください。

If Selection.Value <> "" Then
MsgBox "既に値が入力されています", vbInformation
Exit Sub
ElseIf Selection.Offset(0, 1).Value = "" Then
MsgBox "選択したセルの右隣りのセルにデータがありません", vbInformation
Exit Sub
ElseIf Selection.Offset(0, 2).Value <> "" Then
MsgBox "選択したセルの2個右隣りのセルにデータがあります", vbInformation
Exit Sub
End If

なお、最初に書き忘れましたがA列,B列,C列固定での判断ではなく(例としてA列B列と質問していると考えたため)選択したセルを含めて右へ連続した3個の列が対象になります。ですので、数値を振りたい列以外を選択して実行すると場合によってはその列に番号が振られてしまいます。

A列が必ず選択対象になるのでしたら以下を上述のコードの前に追加してください。

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

補足

迅速なご対応、本当に助かりました。
ありがとうございます。
こちら、複数のセルを選択した状態での実行にあたり、
型が一致しませんとのエラーが出てしまうのですが、
どうすればよいのでしょうか。
何度も申し訳ございません。

回答No.9

Chiquilin

xが 例えば A15だったら

=IFERROR(LOOKUP(1,0/(A$1:A14<>"")/(B$1:B14=B15),A$1:A14)+1,1)

回答No.8

kkkkkm

No4で
バナナとかリンゴ等の最初に何も数値が入っていない場合は選択したセルに1が入ります。
としていましたが、もし上記の条件ではなくバナナとかリンゴ等選択したセル（質問の例だとA列)の右隣りの値が最初に現れた(最も行の小さいセル)は必ず1にしたい場合は以下のマクロで

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.Value <> "" Then
MsgBox "既に値が入力されています", vbInformation
Exit Sub
ElseIf Selection.Offset(0, 1).Value = "" Then
MsgBox "選択したセルの右隣りのセルにデータがありません", vbInformation
Exit Sub
End If
TargetRow = Selection.Row
TargetColumn = Selection.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.Value = Cells(i, TargetColumn).Value + 1
Exit For
ElseIf i = 1 Then
Selection.Value = 1
End If
Next
j = 1
For i = TargetRow + 1 To Cells(Rows.Count, TargetColumn).End(xlUp).Row
If Cells(i, TargetColumn).Value <> "" And _
Cells(TargetRow, TargetColumn + 1).Value = Cells(i, TargetColumn + 1).Value Then
Cells(i, TargetColumn).Value = Selection.Value + j
j = j + 1
End If
Next
End Sub

補足

補足までいただきありがとうございます。
NO.8の方法でうまくいきました。
もし可能であれば下図のようにC列が空白の場合に、
数字を自動的に振り分ける方法を教えていただけますでしょうか。

A　　B　　C
　　・
　　・
　　・
1　リンゴ
　リンゴ P
2　リンゴ
3　リンゴ

1　バナナ
2　バナナ
　 バナナ P
3　バナナ
　 バナナ
4　バナナ
　 バナナ P
　 バナナ P
5 バナナ
　　・　
　　・　
　　・

回答No.7

imogasi

#5です。
＞それに+1した値を挿入するという方法はあります
エクセル関数を用いては、式を入れるセル以外のセルに、狙い撃ちして、そのセルに、値をセットする方法は、原理的にありません。
初心者から、このことを忘れた質問が出ることがある。
VBAなら容易いのです。
ーー
値を取得することなら、
例えば、データの最下行のすぐ上のセルの値を採ってこれます。
関数だけでやるとして、
Ａ列として、上行からデータが空白行なしに詰まっているとして、
例　Ａ１：Ａ５
a
s
d
tt
111
A８などデータなしセル（例　A８）に式を入れて
=INDEX(A:A,COUNTA(INDIRECT("A1:A"&(ROW()-1)))-1)
で　ff が返ります。
やっていることは、A列の例で、「第１行目から式を入れる直前セルまでの空白でないセル数＝ｎ」をCOUNTA関数で数え、第I行目から（ｎ－１）番目の行のデータを取って来る。

回答No.6

msMike

マクロなんて大袈裟なァ～！
「xのセル」を選択⇒「=」を入力⇒Ctrl+↑⇒「+1」を入力⇒Enterをパシーッ

回答No.5

imogasi

ＶＢＡの利用なので、質問者にはだめだろうな。
Ｅｘｃｅｌ関数で回答希望とか、質問にかくべきだ。
この手の質問は関数式では、初心者にはむつかしい組み合わせが必要なのだ。
シートで、ＡＬＴ＋Ｆ１１を押して、出てくる標準モジュールの画面にコピペ。
ユーザー関数
Function fndnsrev(a As Range)
c = a.Column
r = Application.ThisCell.Row
For i = r - 1 To 1 Step -1
If Cells(i, c) <> "" Then ' ??????
fndnsrev = i
Exit Function
Else
End If
Next i
End Function
シートに戻って結果を入れるセルに
関数の要領で　例えばＣ９セルに　=fndnsrev(A1)
と入れる。
例データ　Ａ１：Ａ６
aa
s
d
12
空白
23　　　＜－－Ａ５
2　　　　＜－－Ａ６
空白　　　＜－－Ａ７

とあるとすると
関数をＤ９に入れるとして、
Ａ列の第９行より上に非空白セルを探してＡ６の行６に至り、すぐ上の２３を返す。
質問の場合だと、Ｄ９セルに
=INDEX(A:A,fndnsrev(A1)-1)
を入れると、２３となる。

回答No.4

kkkkkm

No2は勘違いでした。
xのところにですね。選択したセルxのところに数値を入れます。
バナナとかリンゴ等の最初に何も数値が入っていない場合は選択したセルに1が入ります。すでに数値が降られていてその間のセルを選択して実行すると、数値を昇順に降り直します。

Sub Test()
Dim TargetRow As Long
Dim i As Long, j As Long

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

回答No.3

nishi6

回答の添付図のような位置で、

セルA17：=INT(SQRT(SUMPRODUCT(($B$1:$B16=B17)*$A$1:$A16)*2))+1

とします。

中学校の算数？
1+2+3+…n = n(n+1)/2 から近似値を計算して整数にして+1。
1000くらいまで確認済み。

回答No.2

kkkkkm

Xがどこになるのか不明ですがたとえば50行だとしたら
マクロで以下のようにすれば可能です。

Sub Test()
Dim LastRow As Long

LastRow = Cells(50, "A").End(xlUp).Row
Cells(LastRow + 1, "A").Value = Cells(LastRow, "A").Value + 1

End Sub