advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 37696 for IF (0.008 sec.)
[[20090610220538]]
#score: 1591
@digest: 43e7ee7e95cdcea19a6d6dd048b7d273
@id: 43888
@mdate: 2009-07-08T06:43:19Z
@size: 6064
@type: text/plain
#keywords: retsu (8704), ボス (8300), split (4053), remove (3812), clng (3788), ky (3061), iii (2866), txt (2607), instr (2507), tbl (2378), ーワ (2120), トン (2114), vbinformation (1993), ubound (1936), 値2 (1920), 値1 (1907), 数入 (1713), keys (1590), vbcrlf (1568), iserror (1445), ン) (1323), 索値 (1317), union (1216), ii (1151), 索範 (1148), 検索 (1139), rng (1070), 単語 (1005), then (931), empty (912), inputbox (773), next (668)
『複数の単語を検索したい』(なお)
はじめまして。初歩的な質問で申し訳ないのですが、エクセルで複数の単語を検索する方法はありますか?(インターネットなどで検索をするときのイメージです。) 複数の条件に当てはまった場合、決まった数値を返す〜といった関数はみつけたのですが、数値を返すのではなく、条件に当てはまるセルを調べたいのです。 ある程度は一定の項目ですが、全く同じ項目でセルの内容を入れることができないので、オートフィルタなどを使うことも上手くいきません。 もしその様な方法があるようでしたら、教えて下さい。 ---- 普通に検索で 「検索値1*検索値2」 ではだめですか。 ---- こんなものはどうでしょうか。(ROUGE) Sub Nao() Dim rng As Range Dim txt As String Dim x, tbl, ky, y() Dim i As Long, ii As Long, iii As Long Dim n As Long, m As Long If TypeName(Selection) <> "Range" Then MsgBox "検索範囲を選択してから実行してください", vbExclamation Exit Sub End If With Selection tbl = .Value n = .Cells(1, 1).Row - 1 m = .Cells(1, 1).Column - 1 End With txt = Application.InputBox("キーワードを入力してください" & vbCrLf & _ "複数入力する場合はスペースで区切ります" & vbCrLf _ & "-から始まるキーワードはNot検索になります", Type:=2) If Len(txt) = 0 Then Exit Sub x = Split(txt) With CreateObject("Scripting.Dictionary") If Left(x(0), 1) = "-" Then For ii = 1 To UBound(tbl, 2) For i = 1 To UBound(tbl, 1) If Not IsError(tbl(i, ii)) Then If InStr(1, tbl(i, ii), Mid(x(0), 2)) = 0 Then .Add i & " " & ii, Empty End If Next Next Else For ii = 1 To UBound(tbl, 2) For i = 1 To UBound(tbl, 1) If Not IsError(tbl(i, ii)) Then If InStr(1, tbl(i, ii), x(0)) > 0 Then .Add i & " " & ii, Empty End If Next Next End If For iii = 1 To UBound(x) If Left(x(iii), 1) = "-" Then For Each ky In .Keys If InStr(1, tbl(CLng(Split(ky)(0)), CLng(Split(ky)(1))), Mid(x(iii), 2)) > 0 Then .Remove ky Next Else For Each ky In .Keys If InStr(1, tbl(CLng(Split(ky)(0)), CLng(Split(ky)(1))), x(iii)) = 0 Then .Remove ky Next End If Next If .Count Then txt = "" x = .Keys Set rng = Cells(Split(x(0))(0) + n, Split(x(0))(1) + m) For i = 1 To UBound(x) ky = x(i) txt = txt & Cells(Split(ky)(0) + n, Split(ky)(1) + m).Address(0, 0) & "," If Len(txt) > 245 Then Set rng = Union(rng, Range(Left(txt, Len(txt) - 1))) txt = "" End If Next If Len(txt) > 0 Then Set rng = Union(rng, Range(Left(txt, Len(txt) - 1))) rng.Select Else MsgBox "該当するセルは見つかりませんでした", vbInformation End If End With End Sub ---- 返信が大変遅くなり申し訳ありませんでした。 >普通に検索で 「検索値1*検索値2」 ではだめですか。 探していた内容です!助かりました!! ありがとうございました。 ---- 横からすいません 興味を持ちまして 検索範囲を指定する場合は どこにコ-ドを記述すればよいのでしょうか? 例えば (A1:Z100)まで範囲 よろしくお願いします。 (ボストン) ---- 遅くなりました。 こんな感じでどうでしょうか。 詳細な検証はしておりませんので、不具合があったらお知らせください。 (ROUGE) Sub Boston() Dim rng As Range Dim txt As String Dim x, tbl, ky, y() Dim i As Long, ii As Long, iii As Long Dim n As Long, m As Long With Range("A1:Z100") '<--ここで設定してください。 tbl = .Value n = .Cells(1, 1).Row - 1 m = .Cells(1, 1).Column - 1 End With txt = Application.InputBox("キーワードを入力してください" & vbCrLf & _ "複数入力する場合はスペースで区切ります" & vbCrLf _ & "-から始まるキーワードはNot検索になります", Type:=2) If Len(txt) = 0 Then Exit Sub x = Split(txt) With CreateObject("Scripting.Dictionary") If Left(x(0), 1) = "-" Then For ii = 1 To UBound(tbl, 2) For i = 1 To UBound(tbl, 1) If Not IsError(tbl(i, ii)) Then If InStr(1, tbl(i, ii), Mid(x(0), 2)) = 0 Then .Add i & " " & ii, Empty End If Next Next Else For ii = 1 To UBound(tbl, 2) For i = 1 To UBound(tbl, 1) If Not IsError(tbl(i, ii)) Then If InStr(1, tbl(i, ii), x(0)) > 0 Then .Add i & " " & ii, Empty End If Next Next End If For iii = 1 To UBound(x) If Left(x(iii), 1) = "-" Then For Each ky In .Keys If InStr(1, tbl(CLng(Split(ky)(0)), CLng(Split(ky)(1))), Mid(x(iii), 2)) > 0 Then .Remove ky Next Else For Each ky In .Keys If InStr(1, tbl(CLng(Split(ky)(0)), CLng(Split(ky)(1))), x(iii)) = 0 Then .Remove ky Next End If Next If .Count Then txt = "" x = .Keys Set rng = Cells(Split(x(0))(0) + n, Split(x(0))(1) + m) For i = 1 To UBound(x) ky = x(i) txt = txt & "," & Retsu(Split(ky)(1) + m) & CStr(Split(ky)(0) + n) If Len(txt) > 245 Then Set rng = Union(rng, Range(Mid(txt, 2))) txt = "" End If Next If Len(txt) > 0 Then Set rng = Union(rng, Range(Mid(txt, 2))) rng.Select Else MsgBox "該当するセルは見つかりませんでした", vbInformation End If End With End Sub Private Function Retsu(ByRef n As Long) As String Const Col As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" If n > 26 Then Retsu = Retsu(Int((n - 1) / 26)) & Mid(Col, (n - 1) Mod 26 + 1, 1) Else Retsu = Mid(Col, (n - 1) Mod 26 + 1, 1) End If End Function ---- ROUGEさん 首を長くしてお待ちしていました(笑) 動作確認OKでした。 ぜひ、仕事で使わせていただきます。 ありがとうございました。 (ボストン) ...
https://www.excel.studio-kazu.jp/wiki/kazuwiki/200906/20090610220538.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97055 documents and 608272 words.

訪問者:カウンタValid HTML 4.01 Transitional