Excel VBA質問箱 IV

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

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


11684 / 13645 ツリー ←次へ | 前へ→

【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("検索する文書のキーワードを入力(全角、半角、大文字、小文字全て入力可)", "検索")  'インプットボックスに、入力した値をaに代入

'キャンセルが押されたときの処理
  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

 ↓ 2つあわせて。
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 -

引用なし
パスワード
   有難うございます。すみません、風邪でダウンしていて、お礼が遅れてしまいました。
出来ました!本当に有難うございます。

11684 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free