[[20050811191218]]　『ＬＩＳＴシートより飛ばしたい』（竜太）　ページの最後に飛ぶ

『ＬＩＳＴシートより飛ばしたい』（竜太）

 みかんＳｈｅｅｔ					LISTSheet	
みかん	おいしい	←と飛ばしたい		みかん	おいしい
	オレンジ				みかん	オレンジ
	愛媛				みかん	愛媛
	ぶつぶつ				みかん	ぶつぶつ
	ビタミンシー			みかん	ビタミンシー
	大好き				みかん	大好き
	こおりゃええ			みかん	こおりゃええ
	木				みかん	木
	三文字				みかん	三文字
	しりとりはだめ			みかん	しりとりはだめ
					りんご	ゴリラ
					りんご	ダイエット
					りんご	ジュース
					りんご	おもいつかへん
					りんご	酢
					りんご	シャーベット
					りんご	3文字
					りんご	濁音
					りんご	あつい
					りんご	しんどー
					りんご	多すぎ
					スイカ	種
					スイカ	色かわいい
					スイカ	利尿効果
					スイカ	○
					スイカ	×
					・	・
					・	・
					・	・

 Ｓｈｅｅｔは沢山あり、シート名と同じものを抽出したいのです
 出来そうで、全く出来なくて困ってます。結局出来てないのですが(>_<)

 LIST Sheetの[みかん、りんご、スイカ・・・]が昇順でも降順でもいいですが、
まとまって一つのブロックになっている事を前提とした、関数処理の一例です。
みかん等のシートを全選択し（当然LISTシートは除きます）
 A1セルで、シート名を取得します。
=MID(CELL("filename",A1),FIND("]",CELL("filename",A1),1)+1,31)
 B列で表示していくとして、B1セルに
=IF(ISNUMBER(MATCH($A$1,LIST!$A$1:$A$30,FALSE)),
IF(COUNTIF(LIST!$A$1:$A$30,$A$1)>=ROW(),
OFFSET(INDIRECT(ADDRESS(MATCH($A$1,LIST!$A$1:$A$30,FALSE),1,1,1,"LIST")),ROW()-1,1),
""),"")
（※長～いので改行してます。）
として、B20セルぐらいまでコピー＆ペーストしてくださいまし。
尚、LISTシートのデータ範囲は、A1:B30として作ってますので、該当範囲に変更してください。
 沢山のシートがどれぐらいかわかりませんが、演算が遅くなる可能性は大です。
(sin)　他にも方法はあると思いますが、とりあえずの方法です。

 最後までフォロー出来ないかもしれませんが、、、sinさんが回答してくれたので安心しました。
LISTSheetシートのAB列に
みかん	おいしい
みかん	オレンジ
みかん	愛媛
みかん	ぶつぶつ
みかん	ビタミンシー
みかん	大好き
みかん	こおりゃええ
みかん	木
みかん	三文字
みかん	しりとりはだめ
りんご	ゴリラ
りんご	ダイエット
りんご	ジュース
りんご	おもいつかへん
りんご	酢
りんご	シャーベット
りんご	3文字
りんご	濁音
りんご	あつい
りんご	しんどー
りんご	多すぎ
スイカ	種
スイカ	色かわいい
スイカ	利尿効果
スイカ	○
スイカ	×
こんなデータがあるとして、各シートを作って↓このコードを標準モジュールに記述してください。
どうでしょうか？？
Option Explicit
Sub てすと()
Dim MyA As Variant
Dim MyWh() As Variant
Dim wh As Worksheet
Dim i As Long, k As Long
With Sheets("LISTSheet")
    MyA = .Range("A1", .Range("A65536").End(xlUp)).Resize(, 2).Value
    For Each wh In Worksheets
        For i = 1 To UBound(MyA, 1)
            If MyA(i, 1) = wh.Name Then
            k = k + 1
            ReDim Preserve MyWh(1 To k)
                MyWh(k) = MyA(i, 2)
            End If
        Next
        If k > 0 Then
            wh.Range("A1").Resize(UBound(MyWh)).Value = Application.Transpose(MyWh)
        End If
        k = 0
    Next
End With
Erase MyA, MyWh
End Sub
（SoulMan）

 すんげーーーーー関数の達人とマクロの達人にかかると
 できちゃうんですねーーーーー＼(^o^)／　すんげーーーーーでも、理解できねーーー
 感動しました。<m(__)m>　ありがとうございました。感謝です<(_ _)>（竜太）
 むずかすぃーーーー

コメント返信：

[ 一覧(最新更新順) ]

[[20050811191218]] 『ＬＩＳＴシートより飛ばしたい』（竜太） ページの最後に飛ぶ

[[20050811191218]]　『ＬＩＳＴシートより飛ばしたい』（竜太）　ページの最後に飛ぶ