Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11685 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【14637】全ｼｰﾄの検索結果表示 ママさん 04/6/3(木) 16:25 質問[未読]
【14638】Re:全ｼｰﾄの検索結果表示 Jaka 04/6/3(木) 17:16 回答[未読]
【14677】Re:全ｼｰﾄの検索結果表示 Jaka 04/6/4(金) 12:36 回答[未読]
【14756】Re:全ｼｰﾄの検索結果表示 Jaka 04/6/7(月) 9:10 回答[未読]
【14761】Re:全ｼｰﾄの検索結果表示 ママさん 04/6/7(月) 11:03 お礼[未読]
【14637】全ｼｰﾄの検索結果表示
質問  ママさん  - 04/6/3(木) 16:25 -
引用なし
パスワード
   こんにちは。
以前ご意見を頂き有難うございます。
今、全ｼｰﾄの検索結果を別のｼｰﾄに表示させたいのですが、できないので、教えて下さい。
ｼｰﾄ毎の検索結果を表示させることはできたのですが、全ｼｰﾄに該当する検索結果を表示させるマクロを教えて下さい。
下記にのせてるのは、1ｼｰﾄの検索結果を「検索結果」ｼｰﾄに表示させるﾏｸﾛです。
もっと簡単なﾏｸﾛってありますか？


' ｢シート内容｣を検索する
'
Sub シート1を検索()
　　Sheets("検索結果").Select　'検索結果シートを選択
　　Cells.Select　　　　　　　'全てのセルを選択
　　Selection.Clear　　　　　　'選択範囲を全てクリア

'-----------------------------------

'インプットボックスの表示
　　a = Application.inputbox("検索する文書のキーワードを入力（全角、半角、大文字、小文字全て入力可）", "検索")　 'ｲﾝﾌﾟｯﾄﾎﾞｯｸｽに、入力した値をａに代入

'キャンセルが押されたときの処理
　　If a = False Then
　　　　Sheets("検索結果").Range("A1").Select
　　　Exit Sub
　　End If

'　[a]変数の中身を全て全角に変換する。（英数字の大文字・小文字は最初から区別していない）
'　ただし，検索するセルの中身は，最初から全角に変換しておく必要有り。
　　a = StrConv(a, vbWide)　　　'半角文字を全角に変換
　　aa = "*" + a + "*"
'-----------------------------------

'フィルタをかける
　　Sheets("No.1").Select
　　Range("A4").Select
　　Selection.AutoFilter
　　'選択した範囲にフィルタをかける
　
'-----------------------------------

'5列目（E列）にJIS関数（半角を全角に変換する関数）している
'5列目（E列）より[aa]変数を検索する
　　Selection.AutoFilter Field:=5, Criteria1:=aa
　　
'-----------------------------------

'上記にて検索された値を全て選択し、[b]変数に代入する
　　Set b = Range("A4").CurrentRegion
　　b.Copy　 '[b]変数をコピーする
　　
'[b]変数を貼り付ける
　　Sheets("検索結果").Select
　　Range("A2").Select
　　Activesheet.Paste
　　
'フィルタを解除
　　Sheets("検索結果").Select Selection.AutoFilter　'選択した範囲のフィルタを解除
'フィルタをかける（検索結果の解除）
　　Sheets("No.1").Select Selection.AutoFilter　'選択した範囲でフィルタをかける
'フィルタを解除してデータをすべて表示
　　Sheets("No.1").Select Selection.AutoFilter　'選択した範囲のフィルタを解除
　　
　　Sheets("検索結果").Select
　　Range("A1").Select

End Sub
【14638】Re:全ｼｰﾄの検索結果表示
回答  Jaka  - 04/6/3(木) 17:16 -
引用なし
パスワード
   こんにちは。
ない方が良いくらい中途半端ですが...もう帰りますので。

Sheets("検索結果").Select　'検索結果シートを選択
Cells.Select　　　　　　　'全てのセルを選択
Selection.Clear　　　　　　'選択範囲を全てクリア
　　↓
Sheets("検索結果").Cells.Clear

*******************
'キャンセルが押されたときの処理
　　If a = False Then
　　　　Sheets("検索結果").Range("A1").Select
　　　Exit Sub
　　End If
　　　↓　　違うブック、シートのセルを選択する時は、きっちり仕事を分けましょう。
　　If a = False Then
　　　 Sheets("検索結果").Select
　　　 Range("A1").Select
　　　 Exit Sub
　　End If

*******************
a = StrConv(a, vbWide)　　　'半角文字を全角に変換
aa = "*" + a + "*"
　 ↓
aa = "*" & StrConv(a, vbWide) & "*"
雑誌などでも文字列の連結に「+」を使って書いてある所もありますが、私から見ると「なんだこの雑誌！」と思えてしまいます

。
連結には「&」を使うようにした方が良いです。

*******************
'フィルタをかける
　　Sheets("No.1").Select
　　Range("A4").Select
　　Selection.AutoFilter
　　'選択した範囲にフィルタをかける
　
'-----------------------------------

'5列目（E列）にJIS関数（半角を全角に変換する関数）している
'5列目（E列）より[aa]変数を検索する
　　Selection.AutoFilter Field:=5, Criteria1:=aa

　↓　２つあわせて。
Sh2Ed = Sheets("No.1").UsedRange.Cells(Sheets("No.1").UsedRange.Count).Row
Sheets("No.1").Range("E4:E" & Sh2Ed).AutoFilter Field:=1, Criteria1:=aa
【14677】Re:全ｼｰﾄの検索結果表示
回答  Jaka  - 04/6/4(金) 12:36 -
引用なし
パスワード
   Sub シート1を検索()
　　Dim KSh As Worksheet, a As String, aa As String
　　Dim Sh2EdR As Long, Sh2EdC As Long, CCR As Long
　　Sheets("検索結果").Cells.Clear
　　a = Application.InputBox("検索する文書のキーワードを入力（全角、半角、大文字、小文字全て入力可）", "検索")
　　If a = False Then
　　　 Sheets("検索結果").Select
　　　 Range("A1").Select
　　　 End
　　End If
　　aa = "*" & StrConv(a, vbWide) & "*"
　　For Each KSh In Worksheets
　　　　If KSh.Name <> "検索結果" Then
　　　　　 Sh2EdR = KSh.UsedRange.Cells(KSh.UsedRange.Count).Row
　　　　　 Sh2EdC = KSh.UsedRange.Cells(KSh.UsedRange.Count).Column
　　　　　 KSh.Range("E4:E" & Sh2EdR).AutoFilter Field:=1, Criteria1:=aa
　　　　　 KSh.Range("A5:A" & Sh2EdR).Resize(, Sh2EdC).SpecialCells(xlCellTypeVisible).Copy
　　　　　 CCR = Sheets("検索結果").UsedRange.Cells(Sheets("検索結果").UsedRange.Count).Row
　　　　　 Sheets("検索結果").Range("A" & CCR).Offset(1).PasteSpecial Paste:=xlValues
　　　　　 Application.CutCopyMode = False
　　　　　 KSh.AutoFilterMode = False
　　　　End If
　　Next
End Sub
【14756】Re:全ｼｰﾄの検索結果表示
回答  Jaka  - 04/6/7(月) 9:10 -
引用なし
パスワード
   無反応ですが...。
一応訂正を。

>　　Dim KSh As Worksheet, a As String, aa As String

>　　If a = False Then
>　　　 Sheets("検索結果").Select
>　　　 Range("A1").Select
>　　　 End
>　　End If

String型にしたので、こうでしたね。
　　If a = "False" Then
【14761】Re:全ｼｰﾄの検索結果表示
お礼  ママさん  - 04/6/7(月) 11:03 -
引用なし
パスワード
   有難うございます。すみません、風邪でﾀﾞｳﾝしていて、お礼が遅れてしまいました。
出来ました！本当に有難うございます。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11685 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free