- 締切済み
エクセルVBA シート名の部分一致検索について エクセル2007
VBAでエクセルの全シート名を部分一致で検索したいと考えています。 そこで以下のコードを書いたのですが、 インプットボックスにどんな文字列を入力しても全てのシート名を 取得してしまって途方にくれています。 どなたかお助けください。 Sub test01() Dim name As String Dim ws As Worksheet shn = InputBox("検索文字列を入力") For Each ws In ThisWorkbook.Worksheets If ws.Name Like " * " & name & " * " Then ws.Activate MsgBox ws.Name End If Next ws End Sub
- pulu99
- お礼率25% (2/8)
- オフィス系ソフト
- 回答数3
- ありがとう数2
- みんなの回答 （3）
- 専門家の回答
みんなの回答
- imogasi
- ベストアンサー率27% (4737/17068)
今後は 重要な変数（この場合Ｎａｍｅ）の前にＭｓｇｂｏｘ Ｎａｍｅなどを入れるクセをつけるのはどうかな。 うまく行かないことが判った、後からでもテストで入れるのも良い。 そういうデバッグ過程なくして、ここへ質問しているようなのが問題だ。 ーー そうすれば、こんな質問のような単純な不都合は防げるかもしれない。
- hige_082
- ベストアンサー率50% (379/747)
＞Dim name As String これ、おかしくない？ ＞shn ⇒ name に訂正します。 では無く name ⇒ shn に訂正した方がいいよ ws.NameのNameとかぶってるよね Nameは変数？それともプロパティ？とEXCELさんが悩んでいると思います なぜ、コンパイルエラーがでないのかは、私の知識では説明できませんが・・・ Sub test01() Dim shn As String Dim ws As Worksheet shn = InputBox("検索文字列を入力") For Each ws In ThisWorkbook.Worksheets If ws.Name Like "*" & shn & "*" Then ws.Activate MsgBox ws.Name End If Next ws End Sub
お礼
おかげさまで無事思い通りの結果を得られました。 本当にどうもありがとうございました。
- hana-hana3
- ベストアンサー率31% (4940/15541)
INPUTBOXで変数shn入れる目的はなんでしょうか？ で、nameってどこから値を貰ってるの？
補足
ごめんなさい。 投稿した後に間違いに気付きました。 shn ⇒ name に訂正します。
関連するQ&A
- VBA シート名とファイル名とフォルダ名を一度に変更したい
こんばんは。 現在のアクティブセルに入力された文字列「(例）0001」を入力するとシート名、ファイル名、フォルダ名が変更するVBAを作成しています。 シート名の変更は出来たのですが、ファイル名とフォルダ名の変更が上手くいきません。 大変恐れ入りますが、伝授いただけないでしょうか。 よろしくお願い致します。 Sub シート名変更() Dim シート名 As String シート名 = ActiveCell.Value If シート名 = "" Then MsgBox "文字列を含むセルを選択してください。" Exit Sub End If ActiveSheet.Name = シート名 End Sub
- ベストアンサー
- その他（プログラミング・開発）
- Excel VBAで文字列の部分一致の文字列を表示
以前、こちらで頭５文字までの一致で文字列を表示するVBAを教えて頂きました。今回はFINDなどの部分一致での文字列を表示することをしたいのですが、ご教示いただけますと幸いです。 下記はSheet1のA3に文字を5文字以内いれるとSheet２のC列からピックアップしてSheet１のA列に文字列を表示する及びSheet２のB列のデータをSheet１のC列に表示させるVBAです。 Sub Test2() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim SData As String, i As Long, VRet As Variant Dim c As Range, LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") SData = CStr(Ws1.Range("A3").Value) If SData = "" Then Exit Sub i = 5 LastRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row If LastRow < i Then LastRow = i End If Ws1.Range(Ws1.Cells(i, "A"), Ws1.Cells(LastRow, "C")).ClearContents With Ws2 For Each c In .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)) VRet = InStr(1, CStr(c.Value), SData, vbTextCompare) If VRet = 1 And Len(c.Value) >= 10 Then Ws1.Cells(i, "A").Resize(1, 2).Value = c.Resize(1, 2).Value 'とりあえずSheet2のB列のデータ(C列のデータに同期したデータ)をSheet1のC列に Ws1.Cells(i, "C").Value = .Cells(c.Row, "B").Value i = i + 1 End If Next End With End Sub 宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- ExcelのVBAについてです。シート1と2を作成
ExcelのVBAについてです。シート1と2を作成し、シート1にバーコードまたはキーボードで入力します。シート1は入力専用かつ入力した分の早見表で、実際にはシート2に転記仕訳して、シート3以降に表を作成したいです。使い方はシート1に入力またはシート2をタップまたはクリックすると入力(画面)になります。以前の質問の回答を参考に必要最低限に改良しています。パッと見で構いません、何か不具合は見付からないでしょうか？ '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Dim st1, s, i3 As Long Dim Bst As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 st1 = ws1.Cells(Rows.Count, "E").End(xlUp).Row 'A列の最終行を設定する s = 3 For i3 = 3 To st1 Set Bst = ws2.Columns("E").Find(What:=ws1.Cells(i3, "E"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) シート間のE列を比較 If Bst Is Nothing Then '比較して無い場合は、下記を実行 ws1.Cells(s, "A") = ws1.Cells(i3, "A") '追加する文字を転記する。（コード） s = s + 1 End If Next i3 Next i '(1)シートを変数にセット Dim ws1_ As Worksheet Set ws1_ = Worksheets("Sheet1") ws1_.Activate End Sub
- ベストアンサー
- その他（プログラミング・開発）
- エクセルVBA任意の文字で検索しリストUPするには
お世話になります。 恥ずかしながら、VBAはまるっきりの初心者でネットで落ちているものを かき集めて貼り合せることしかできません。 A列に仕入先名、 B列に品番、 C列に注文数 のデータがあり、 仕入先を指定して、注文数>0、の品番を別シートにコピペするマクロを作っています。 ここで、困っているのが、仕入先を正確に入力しないといけない点です。 特に株式会社の標記です。 株式会社、（株）、(株)、前(株)、後(株)、記号の株 など そこで、社名の一部だけ入力すれば検索できるようにしたいのですが、 どうしたらよいでしょうか？ ワイルドカード * を使えばよいのかと思いましたが、うまくいきません。 都合の良い相談ですが、助けて頂けると幸いです。 Sub test() Dim name As Range Dim 仕入先 As String 仕入先 = Application.InputBox("検索仕入先入力") For Each name In Range("A1:A65536") ' 第1条件 仕入先 If name.Value <> 仕入先 Then GoTo Continue End If ' 第2条件 注文数 If name.Offset(0, 2).Value <= 0 Then GoTo Continue End If Dim aValue As String aValue = name.Offset(0, 1).Value Dim rngPaste As Range Set rngPaste = Worksheets("Sheet2").Range("A65536").End(xlUp) If rngPaste.Value <> "" Then Set rngPaste = rngPaste.Offset(1) End If rngPaste.Value = aValue Continue: Next End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルVBAでFindを使った検索について
エクセル2003でVBAを勉強し始めたものです。 findを用いた検索についてご教授をお願いしたく、ご質問させていただきます。 まず、 ＜シート１＞ A列：受付No. B列：氏名 C列：物件名 ＜シート２＞ A～F列：省略 G～O列：物件名 とあります。 シート１上にコマンドボタンがあり、クリックするとシート１への入力用フォームが開きます。 さらに、そのフォーム内のテキストボックスに物件名を入力するのですが、テキストボックス内でダブルクリックで、物件検索用のフォームが開きます。 物件検索用フォーム内のテキストボックス（Text物件名検索）に文字列を入力し、コマンドボタン（command物件名検索）をクリックすると、フォーム内下部のリストボックス（List物件検索結果）内に、シート２のG～O列を検索した結果が並ぶようになっています。 その候補の中から選択したものが、シート１の物件名の列に並ぶようにしたいのです。 そこで、エクセルファイルを開いたすぐ後は、検索結果が意図通りに表示するのですが、一度他のコード（マクロにてシート１の行削除等）を実行した後、再度物件検索を行うと、検索結果が“なし”（その場合は「見つかりませんでした」とメッセージボックスが開くようにしてあります）となってしまいます。 変数の扱いがわるいのでしょうか？・・・ どうぞご教授のほどよろしくお願いいたします。 以下、検索用フォームのテキストボックス入力後、コマンドボタン(command物件名検索）をクリックしたときの処理コードです。 --------------------------------------- Private Sub command物件名検索_click() Dim bname As String Dim fndrange As Range Dim firstcell As String bname = Text物件名検索.Text Set fndrange = Sheets("TBオーナー").Columns("g:o").Find(bname) If bname = "" Then MsgBox ("キーワードを入力してください") Exit Sub Else If fndrange Is Nothing Then MsgBox ("見つかりませんでした") Text物件名検索.Text = "" Text物件名検索.SetFocus Else If Not fndrange Is Nothing Then firstcell = fndrange.Address Do Set fndrange = Sheets("TBオーナー").Columns("g:o").FindNext(fndrange) List物件検索結果.AddItem fndrange.Value Loop While Not fndrange Is Nothing And fndrange.Address <> firstcell End If End If End If End Sub ----------------------------------------- また、関係あるかわかりませんが、他のコード（シート１から行を削除するマクロ）も掲載させていただきます。 以下、 -------------------------------------- Private Sub Command削除_Click() Dim t As Long Dim DelNo As String Dim delNos As Long Dim s As Range DelNo = InputBox("削除するデータＮＯを入力してください") delNos = Val(DelNo) Set s = Sheets("TBマスター").Columns("A").Find(delNos, lookat:=xlWhole) If DelNo = "" Then Exit Sub ElseIf s Is Nothing Then MsgBox ("データがありません") Exit Sub Else t = Sheets("TBマスター").Columns("A").Find(delNos, lookat:=xlWhole).Row Rows(t).Delete End If End Sub --------------------------------------------------------- 質問のが悪いかも知れませんが、必要なことがあれば随時追記させてください。 以上、よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- VBAでワークシートを変数にするとき
たとえばSheet1とSheet2を一度に選択する場合、 Sub Macro6() Sheets(Array("Sheet1", "Sheet2")).Select End Sub と書くと思います。 ワークシートを変数で書く場合は Sub test() Dim ws1 As Worksheet, ws2 As Worksheet Sheets(Array(ws1.Name, ws2.Name)).Select End Sub と、いちいち名前で指定しなければならないのでしょうか？ それとももっと別の書き方があるのでしょうか？
- ベストアンサー
- その他MS Office製品
- Excel VBA で特定のシートのみ除外
ＶＢＡで以下のような、ブック内の全シートから特定の文字列が入った行のみを新しくシート作成して一覧化するマクロを組みました。 検索する時に保護解除するなど別の作業もあるため無駄に長くなっております。 Sub 検索() Dim Sh As Worksheet, Rng As Range Dim StrFind As String, Res As String Dim Rw As Long, R As Long Dim N As Integer Const OutShName = "検索結果" StrFind = InputBox("検索する文字列を入力してください。" & " 検索する文字列は正確に。", "検索文字列") If StrFind = vbNullString Then Exit Sub Dim Ws As Worksheet Application.ScreenUpdating = False For Each Ws In Worksheets Ws.Unprotect Password:=908118 Next Application.ScreenUpdating = True Application.ScreenUpdating = False UserForm1.Show vbModeless UserForm1.Repaint For N = 1 To Worksheets.Count If Worksheets(N).Name = OutShName Then Set Sh = Worksheets(N) Sh.Move after:=Worksheets(Worksheets.Count) Sh.Cells.ClearContents Exit For End If Next N If N > Worksheets.Count Then Set Sh = Sheets.Add(after:=Worksheets(Worksheets.Count)) Sh.Name = OutShName End If Worksheets(1).Rows(1).Copy Sh.Rows(1) R = 2 For N = 1 To Worksheets.Count - 1 With Worksheets(N).UsedRange For Rw = 1 To .Rows.Count Set Rng = .Cells(Rw, 1).Resize(, .Columns.Count).Find(StrFind) If Not Rng Is Nothing Then Rng.EntireRow.Copy Sh.Rows(R) R = R + 1 End If Next Rw End With Next N Unload UserForm1 ResultMsg: If R < 3 Then Res = "「" & StrFind & "」 は、見つかりません。" For Each Ws In Worksheets Ws.Protect Password:=908118 Next Sheets("TOP").Select Else Columns("A:A").ColumnWidth = 20 Columns("C:C").ColumnWidth = 13 Rows("1:1").RowHeight = 30 Sheets("12月").Select Rows("1:1").Select Selection.Copy Sheets("検索").Select Range("A1").Select Application.ScreenUpdating = True Res = "「" & StrFind & "」 は、" & R - 2 & " 件 見つかりました。 " & _ String(2, vbLf) & Sh.Name & " に抽出しました。" Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Font.Bold = False Selection.Font.Bold = True End If MsgBox Res, vbInformation, "検索完了" Set Rng = Nothing End Sub Excel2003を使用してます。 シートは30枚程あり、複雑な計算式等が入っています。 この時、特定のシート（例:"月別データ")のみを除外したいのですが、いまいちわかっておりません。 稚拙な質問かと思いますがご指導していただきたく思います。
- 締切済み
- その他MS Office製品
- VBAで複数のシート名を置換する処理
Dim ws As Worksheet Dim i As Long For i = 1 To ThisWorkbook.Sheets.Count For Each ws In ThisWorkbook.Sheets If ws.name Like "*T*" Then ws.name = Replace(ws.name, "T", "S") End If Next Next End Sub この処理をするとnameメソッド失敗worksheetオブジェクト 処理できるようにするにはどうすればいいんでしょうか
- ベストアンサー
- Visual Basic
- Excel VBA シート名を条件に使用して…
Excel2003を使用しています。 C列に特定の文字が入力されたら、その行のG列に、ある数式を入力したく、イベントマクロを作成しましたが、シートがたくさんあるときや、シートの追加がある場合は、クラスモジュールを使用するとよいということを過去の質問から参考にさせていただき、下記のクラスモジュールを作成しました。 ------------------------------------------------------- Public WithEvents myApp As Application Private Sub myApp_sheetchange(ByVal sh As Object, ByVal target As Range) If Len(sh.Name) = 4 Then If target.Column = 3 And target.Row >= 4 Then If target.Value = "特定の文字" Then Cells(target.Row, 7).FormulaR1C1 = "=数式A" End If End If End If End Sub ------------------------------------------------------- 上記マクロを使用しているBook中の30数枚のシート名は「１２３４」というように、4桁の数字(全角)になっているのですが、さらに条件を加えて、例えば、シート名の数字が「１２５０」以下の場合は、Aという数式を入力し、シート名の数字が「２０００」以上の場合は、Bという数式を入力するという条件でも可能でしょうか？ 可能な場合、どのようにコードを記述すればいいのでしょうか？ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
ご投稿ありがとうございます。 imogasi様のご回答にはいつも参考にさせてもらっており 非常に助けられています。 そしてアドバイスをありがとうございました。