エクセルで数値が入力されているセルのアドレス取得

質問

エクセルである範囲の中から、数値が入力されているセルのアドレスもしくは範囲を取得したいです。

　　　　　Ａ列　　Ｂ列　　Ｃ列　　Ｄ列　　Ｅ列・・・
1行目　　20　　　10　　　
2行目　　　　　　 11　　　　　　 　15　　 10　　
3行目　　　　　　　　　　　　　　 　25　　 30　

範囲指定　A1:E3

結果　A1,B1,B2,D2,D3,E2,E3
　　　　もしくはA1:B2,D2:E3　という結果がでるとうれしいです。よろしくお願いします。

回答No.7

imogasi

エクセルでは、したいことを達成する方法として
（１）操作
（２）関数
（３）VBA
（４）アドインやソフト（他の熟練者が作ったまとまった目的のプログラム）
があることをいつも思い起こしてください。（３）は経験が必要です。質問者のスキルで左右される面が大きい。
質問にはある程度の質問者の経験を書いておくほうが、回答者が目安に出来て良い。
本件は、書いてないのでどの程度かわかりません。
＞セルのアドレスもしくは範囲を取得したいです
「取得」なんて難しいことを言っているが、どうしようというのか。
ーー
エクセル操作の例だが
例データ
A2:E4　－は空白セル
a ー 12 45 ー
b aa ー ー 2
c 1 ー 3 f
B2:E4を範囲指定
編集ージャンプーセル選択ー定数ーOK
１２，４５，２，１，３のセル刷毛セル選択される。
こういうエクセルの操作を知っていると有利です。
VBAでもマクロの記録で、結果は１行のコードで済みます。
ーー
マクロの記録では
Sub Macro4()
Selection.SpecialCells(xlCellTypeConstants, 1).Select
End Sub
ーー
これを番地形式でセルに出すなら
Sub Macro4b()
k = 1
Range("B2:E4").SpecialCells(xlCellTypeConstants, 1).Select
For Each cl In Selection
Cells(k, "M") = cl.Address
k = k + 1
Next
End Sub
ーーー
結果
M列に
$C$2
$D$2
$E$3
$B$4
$D$4
ーー
ただし数式の結果で数値になっているものは拾われない。
改良して
Sub Macro4b()
k = 1
Range("B2:E4").SpecialCells(xlCellTypeConstants, 1).Select
For Each cl In Selection
Cells(k, "M") = cl.Address
k = k + 1
Next
Range("B2:E4").SpecialCells(xlCellTypeFormulas, 1).Select
For Each cl In Selection
Cells(k, "M") = cl.Address
k = k + 1
Next
End Sub
ーー
やさしいのはFor Each cl In Range("B2:E4")で全セルチェックする方法です。
Sub Macro4c()
k = 1
For Each cl In Range("B2:E4")
If IsNumeric(cl) = True Then
Cells(k, "L") = cl.Address
k = k + 1
End If
Next
End Sub
＞という結果がでるとうれしいです
番地を出しても、あと何に使うのかな。
次に控えてる問題がむつかしいのでは。

回答No.6

tom04

No.3・4です。

＞数値が入力されているセルが多すぎると、アドレスを表示しきれなくなってしまいます。
＞数値があるセルを範囲でも出せるようにしたいです

とありますが「表示しきれない」ということはかなりのセル数になると思います。
その場合、単にセル番地を羅列しても判りづらいものになるはずです。

すでにお分かりかと思いますが、
仮に　A1:B3　のような表示方法はA1～B3すべてのセルになりますので、A2セルなど途中が空白の場合は好ましくない表示です。

そこで苦肉の策ですが、Sheet1の範囲指定したセル番地をSheet2に各列ごとに表示してみてはどうでしょうか？

そのコードの一例です。
前回同様、Sheet1を範囲指定し↓のコードでマクロを試してみてください。

Sub test()
Dim i, j As Long
Dim str As String
Dim ws As Worksheet
Set ws = Worksheets("sheet2")
If WorksheetFunction.CountA(Selection) Then
ws.Cells.Clear
For j = Selection(1).Column To Selection(Selection.Count).Column
For i = Selection(1).Row To Selection(Selection.Count).Row
If Cells(i, j) <> "" Then
ws.Cells(1, j) = ws.Cells(1, j).Address
ws.Cells(Rows.Count, j).End(xlUp).Offset(1) = _
WorksheetFunction.Substitute(Cells(i, j).Address, "$", "")
End If
Next i
Next j
For j = ws.Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If ws.Cells(1, j) = "" Then
ws.Columns(j).Delete
End If
Next j
For j = 1 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Len(ws.Cells(1, j))
str = Mid(ws.Cells(1, j), i, 1)
If Not str Like "[A-Z]" Then
ws.Cells(1, j) = Replace(ws.Cells(1, j), str, "")
End If
Next i
With ws.Cells(1, j)
.Value = ws.Cells(1, j) & "列"
.Interior.ColorIndex = 36
End With
Next j
Else
MsgBox "範囲内に入力セルはありません。"
End If
End Sub

この程度しか思いつきませんが、
ご希望の方法でなければごめんなさいね。m(_ _)m

お礼

ご回答ありがとうございます。
また、大変ご面倒をお掛けしました。
助かりました。頂いたVBAをまた、
試してみたいと思います。

回答No.5

kagakusuki

今仮に、元の範囲がSheet1!A1:E3であるものとします。
　又、適当な空きシート（例えばSheet2）を作業用のシートとして使用するものとします。

　まず、Sheet2!A1セルに次の関数を入力して下さい。

=IF(Sheet1!A1="","",COLUMN(Sheet1!A1)*1000000+ROW(Sheet1!A1))

　次に、Sheet2!A1セルをコピーして、Sheet2!A1:E3の範囲に貼り付けて下さい。
　次に、Sheet1!A1セルに次の関数を入力して下さい。

=IF(COLUMNS($G:G)>COUNT(Sheet2!$A$1:$E$3),"",SUBSTITUTE(CELL("address",INDIRECT("R"&MOD(SMALL(Sheet2!$A$1:$E$3,COLUMNS($G:G)),1000000)&"C"&INT(SMALL(Sheet2!$A$1:$E$3,COLUMNS($G:G))/1000000),FALSE)),"$",))

　次に、Sheet1!A1セルをコピーして、Sheet1!A1よりも右にあるセル範囲に貼り付けて下さい。

　以上です。

回答No.4

tom04

No.3です。
投稿後に気づいたのですが・・・

＞結果　A1,B1,B2,D2,D3,E2,E3

のように各列を上からの表示がご希望ですよね！

前回のコードでは1行目から列方向に検索していますので、ご希望の表示ではないと思います。

↓のコードに変更してマクロを実行してみてください。

Sub test2()
Dim i, j As Long
Dim str As String
If WorksheetFunction.CountA(Selection) > 0 Then
For j = Selection(1).Column To Selection(Selection.Count).Column
For i = Selection(1).Row To Selection(Selection.Count).Row
If Cells(i, j) <> "" Then
str = str & WorksheetFunction.Substitute(Cells(i, j).Address, "$", "") & ", "
End If
Next i
Next j
MsgBox "入力セルは、" & vbCrLf & Left(str, Len(str) - 2) & vbCrLf & "です。"
Else
MsgBox "範囲内に入力セルはありません。"
End If
End Sub

何度も失礼しました。m(_ _)m

お礼

さっそくの回答ありがとうございます。投稿していただいたVBAで、自分がやりたいと思っていた結果がでました。
ありがとうございます。

ですが、もう少しだけ、お聞きしたいことがあります。かなりデータ数が多いものにも適用できるようにするにはどうしたらよいでしょうか？

数値が入力されているセルが多すぎると、アドレスを表示しきれなくなってしまいます。数値があるセルを範囲でも出せるようにしたいです。

わがままを言って申し訳ありません。どうぞよろしくお願いします。

回答No.3

tom04

こんにちは！
VBAでの一例です。

画面左下にある操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim c As Range
Dim str As String
If WorksheetFunction.CountA(Selection) > 0 Then
For Each c In Selection
If c <> "" Then
str = str & WorksheetFunction.Substitute(c.Address, "$", "") & ", "
End If
Next c
MsgBox "入力セルは、" & Left(str, Len(str) - 1) & "です"
Else
MsgBox "範囲内に入力セルはありません。"
End If
End Sub 'この行まで

※　検索したいセルを範囲指定して、マクロを実行します。

こんなんではどうでしょうか？m(_ _)m

回答No.2

MASUKUBO

回答No1です。
L2への入力の式は次の式がベターでしょう。

=IF(ISERROR(INDEX(INDIRECT($N$1):INDIRECT($O$1),MOD(ROW(A1)-1,ROW(INDIRECT($O$1)))+1,ROUNDUP(ROW(A1)/ROW(INDIRECT($O$1)),0))),"",IF(INDEX(INDIRECT($N$1):INDIRECT($O$1),MOD(ROW(A1)-1,ROW(INDIRECT($O$1)))+1,ROUNDUP(ROW(A1)/ROW(INDIRECT($O$1)),0))>0,CELL("address",INDEX(INDIRECT($N$1):INDIRECT($O$1),MOD(ROW(A1)-1,ROW(INDIRECT($O$1)))+1,ROUNDUP(ROW(A1)/ROW(INDIRECT($O$1)),0))),""))

回答No.1

KURUMITO

式が複雑になりますが次のようにします。
例えばN1セルに指定範囲のA1を、O1セルに指定範囲のE3とそれぞれ文字列を入力します。
そこで作業列としてL2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(ISERROR(INDEX(INDIRECT($N$1):INDIRECT($O$1),ROUNDUP(ROW(A1)/COLUMN(INDIRECT($O$1)),0),MOD(ROW(A1)-1,COLUMN(INDIRECT($O$1)))+1)),"",IF(INDEX(INDIRECT($N$1):INDIRECT($O$1),ROUNDUP(ROW(A1)/COLUMN(INDIRECT($O$1)),0),MOD(ROW(A1)-1,COLUMN(INDIRECT($O$1)))+1)>0,CELL("address",INDEX(INDIRECT($N$1):INDIRECT($O$1),ROUNDUP(ROW(A1)/COLUMN(INDIRECT($O$1)),0),MOD(ROW(A1)-1,COLUMN(INDIRECT($O$1)))+1)),""))

M2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(L2="","",MAX(O$1:O1)+1)

お求めのセルのアドレスはN2セルより下方に表示させるとしてN2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(ROW(A1)>MAX(M:M),"",SUBSTITUTE(INDEX(L:L,MATCH(ROW(A1),M:M,0)),"$",""))