エクセルマクロ ちょっと難しいです

質問

セクセル２０１０を使っています。

画像の様なデータがあります。

F1,G1、H1に入力された名前をA列から探し、その関連セルであるB列を上から順に表示させたいと思います。

現在、F２セルに
=IFERROR(INDEX($B$1:$B$50,SMALL(IF($A$1:$A$50=F$1,ROW($A$1:$A$50)),ROW(A1))),"")

の様な数式が入っていて、G、Hと下行に、オートフィルで数式をコピーしています。

それで、A列の途中から　＃VALUE　のエラーが出てくる場合があるのですが、その場合は一切抜き出してくれません。

これを、抜き出す方法ってありますか？

また、J列からR列、S列からZ列と同じ形式で作業が全部で８つあります。

詳しい方、教えて頂けませんでしょうか、よろしくお願い致します。

回答No.4

mt2008

関数で何とかしてみました。
F1セルに↓（配列数式ですのでCtrl+Shift+Enterで確定）で、如何でしょう
=IF(COUNTIF($A$1:$A$50,F$1)>=ROW(A1),INDEX($B$1:$B$50,SMALL(IF($A$1:$A$50=F$1,ROW($A$1:$A$50)),ROW(A1))),"")

回答No.3

Chiquilin

> それで、A列の途中から　＃VALUE　のエラーが出てくる場合があるのですが
そもそもこれが出ないようにはしないのですか？

というか何故 一式で処理しようとしているのか分かりませんが 非効率だと思います。

F2セル
=IFERROR(INDEX(IFERROR($B$1:$B$50,""),SMALL(IF(IFERROR($A$1:$A$50,"")=F$1,ROW($A$1:$A$50)),ROW(A1))),"")
Ctrl + Shift + Enterで確定

回答No.3

Chiquilin

> それで、A列の途中から　＃VALUE　のエラーが出てくる場合があるのですが
そもそもこれが出ないようにはしないのですか？

というか何故 一式で処理しようとしているのか分かりませんが 非効率だと思います。

F2セル
=IFERROR(INDEX(IFERROR($B$1:$B$50,""),SMALL(IF(IFERROR($A$1:$A$50,"")=F$1,ROW($A$1:$A$50)),ROW(A1))),"")
Ctrl + Shift + Enterで確定

回答No.2

tom04

こんにちは！

画像の配置通りとしての一例です。

Sub Sample1()
Dim j As Long, k As Long, lastRow As Long
Application.ScreenUpdating = False
Rows(1).Insert
Range("A1") = "ダミー"
For j = 6 To Cells(2, Columns.Count).End(xlToLeft).Column Step 9
lastRow = Cells(Rows.Count, j - 5).End(xlUp).Row
Range(Cells(3, j), Cells(lastRow, j + 2)).ClearContents
For k = j To j + 2
Rows(1).AutoFilter field:=j - 5, Criteria1:=Cells(2, k)
If Cells(Rows.Count, j - 4).End(xlUp).Row > 1 Then
Range(Cells(2, j - 4), Cells(lastRow, j - 4)).SpecialCells(xlCellTypeVisible).Copy Cells(3, k)
End If
Next k
ActiveSheet.AutoFilterMode = False
Next j
Rows(1).Delete
Application.ScreenUpdating = True
End Sub

こんな感じでは同でしょうか？ｍ(_ _)ｍ

回答No.1

misatoanna

F1:H1,O1:Q1,X1:Z1 と、検索する名前を入力するセル範囲だけを選択して、名前
ボックスで任意の名前を設定します。
ここでは、とりあえず Area にします。

シートタブの右クリックメニューにある"コードの表示"から開くウィンドウに以下を
記述し、そのウィンドウを閉じます。
-------
Private Sub Worksheet_Change(ByVal Target As Range)
　Dim KY, col, FoundCell, FirstAddress, fnd
　If Intersect(Target, Range("Area")) Is Nothing Then Exit Sub
　KY = Target.Value
　Range(Cells(2, Target.Column), Cells(Rows.Count, Target.Column)).Clear
　col = Int(Target.Column / 9) * 9 + 1
　Set FoundCell = Columns(col).Find(KY, LookAt:=xlWhole, _
　　　After:=Cells(Rows.Count, col), SearchDirection:=xlNext)
　fnd = 1
　If FoundCell Is Nothing Then
　　Target.Offset(1, 0).Value = "－"
　　GoTo Fin
　End If
　Target.Offset(fnd, 0).Value = FoundCell.Offset(0, 1).Value
　FirstAddress = FoundCell.Address
　Do Until FoundCell Is Nothing
　　Set FoundCell = Columns(col).Find(KY, LookAt:=xlWhole, After:=FoundCell)
　　If FirstAddress = FoundCell.Address Then Exit Do
　　fnd = fnd + 1
　　Target.Offset(fnd, 0).Value = FoundCell.Offset(0, 1).Value
　Loop
Fin: Set FoundCell = Nothing
End Sub
-------

Areaという名前を付けたセルのひとつに人名を入力してみてください。