こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

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

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

宜しくお願い致します。

投稿日時 - 2019-11-18 10:49:14

QNo.9680285

困ってます

質問者が選んだベストアンサー

とりあえず
選択した範囲で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

投稿日時 - 2019-11-19 15:58:33

お礼

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

投稿日時 - 2019-11-19 16:28:49

ANo.12

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(12)

ANo.11

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

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

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

投稿日時 - 2019-11-19 15:01:33

補足

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

投稿日時 - 2019-11-19 15:55:43

ANo.10

> もし可能であれば下図のように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

投稿日時 - 2019-11-19 14:22:23

補足

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

投稿日時 - 2019-11-19 14:31:46

ANo.9

xが 例えば A15だったら

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

投稿日時 - 2019-11-19 09:46:41

ANo.8

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

投稿日時 - 2019-11-18 19:10:21

補足

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

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

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

投稿日時 - 2019-11-19 13:23:09

ANo.7

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

投稿日時 - 2019-11-18 17:19:38

ANo.6

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

投稿日時 - 2019-11-18 15:09:19

ANo.5

VBAの利用なので、質問者にはだめだろうな。
Excel関数で回答希望とか、質問にかくべきだ。
この手の質問は関数式では、初心者にはむつかしい組み合わせが必要なのだ。
シートで、ALT+F11を押して、出てくる標準モジュールの画面にコピペ。
ユーザー関数
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
シートに戻って結果を入れるセルに
関数の要領で 例えばC9セルに =fndnsrev(A1)
と入れる。
例データ A1:A6
aa
s
d
12
空白
23   <--A5
2    <--A6
空白   <--A7
 
とあるとすると
関数をD9に入れるとして、
A列の第9行より上に非空白セルを探してA6の行6に至り、すぐ上の23を返す。
質問の場合だと、D9セルに
=INDEX(A:A,fndnsrev(A1)-1)
を入れると、23となる。 

投稿日時 - 2019-11-18 14:11:20

ANo.4

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

投稿日時 - 2019-11-18 14:03:25

ANo.3

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

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

とします。

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

大変申し訳ございませんが、この投稿に添付された画像や動画などは、「BIGLOBEなんでも相談室」ではご覧いただくことができません。 OKWAVEよりご覧ください。

マルチメディア機能とは?

投稿日時 - 2019-11-18 12:36:14

ANo.2

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

投稿日時 - 2019-11-18 11:30:04

ANo.1

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

投稿日時 - 2019-11-18 11:13:30

あなたにオススメの質問