Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

66620 / 76734

←次へ　｜　前へ→


	【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

2 hits

▼

【14637】全ｼｰﾄの検索結果表示 ママさん 04/6/3(木) 16:25