• 締切済み

シートの繰り返し処理がうまく作動せず困っています．

３シートあるブックの繰り返し処理を行うマクロを作成したのですが、シートの情報の取得が うまく動作せず困っています。 当方macro初心者のため教えていただけませんでしょうか？ (1)　以下のマクロを組んだところ１枚目のシートの情報を取得してしまい、３シートとも同様の 　　　処理となってしまいました。(３シートともIF文がTRUEになってしまいました） Dim sh As Worksheet For Each sh In Worksheets If Range("a2").Value = "チーム" Then Call SHEETSET End If Next (2)　他の質問も確認し、シート名を設定するように変更したところ情報が取得できず(empty)、 　　　動作がうまくいかなくなっています。(３シートともIF文がfalseとなってしまいました） Dim sh As Worksheet For Each sh In Worksheets If sh.Range("a2").Value = "チーム" Then Call SHEETSET End If Next いきづまっており、困っております。 申し訳ありませんが教えていただけませんか？

  • hiru2
  • お礼率100% (1/1)

みんなの回答

  • DreamyCat
  • ベストアンサー率56% (295/524)
回答No.1

これで問題なく動作します。 A2にチームという言葉が入っていないとSHEETSETは呼び出されません. ＊callの使い方は理解していますか。 ＊SHEETSETは正しく動作していますか。 Dim sh As Worksheet For Each sh In Worksheets 　　MsgBox sh.Name If sh.Range("a2").Value = "チーム" Then 　　'Call SHEETSET 　　MsgBox sh.name & "チーム" End If Next

hiru2
質問者

お礼

どうもありがとうございました。 ｗｏｒｋｓｈｅｅｔをActiveWorkbook.Worksheetsと指定したら、うまく作動いたしました。（オブジェクトを明確にしていなかったのが理由だったみたいです）

hiru2
質問者

補足

早々にご回答いただきどうもありがとうございました。 教えていただいた内容で実施してみたのですが、うまく動作しません。 情報が足らないようですので、もう少し記載いたしますのでよろしくお願いいたします。 (1)　１シート目のＡ２のセルには”チーム”という言葉が入っています。 (2)　２、３シートはすべて初期値となっています。 (3)　SHEETSETには制御がわたっていません。 　　上記のＩＦ文がfalseとなっているため (4)　デバッグしてみるとsh.Range("a2").value →　empty　となります 　　上記を Range("a2").valueに変更すると　３シートとも"チーム”と 　　なってしまいます。 (5) Range("a2").valueにするとSHEETSETに制御がわたり、SHEETSET 　　自体は正しく作動しています。（ただし３回分（３シート）繰り返して 　　しまっています） 　　 質問自体もわかりづらく申し訳ありませんがよろしくお願いいたします。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. その他MS Office製品

関連するQ&A

  • マクロで質問します。

    初心者です。 下記のようなマクロの式があるのですが、条件を一つ増やしたいのですが、 イロイロ試してみたのですが、うまくゆきませんので教えてください！ Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("D14").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("O2:X14").Copy .Cells(1) .Resize(13, 10).Value = Sh.Range("O2:X14").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub この中で　If Sh.Range("D14").Value > 0 Then　とありますが、 同じ条件で　I14も　０より大きいな時としたいのですが、　うまくゆきませんでした。 たぶん基本できな簡単な事と思いますが　分かりません。 If Sh.Range("D14").Value > 0 Then If Sh.Range("I14").Value > 0 Then　並べてみたり If Sh.Range("D14、I14").Value > 0 Then　こんなのや If Sh.Range("D14、I14").).Value > 0 Then　このような事も 他にも笑われるようなことも・・・・・　よろしくお願いします。

  • 2つのマクロを1つにしたい

    いつもお世話になっております。 今回もよろしくお願いいたします。 (1)14のシートがあるのですが、データーのある2から14までのシートを印刷する。 (2)上記のうち、ｃ列のデーターで連続しているセルを結合する。 (1)と(2)を合わせて1つのマクロにしたいのですが、アクティブシート１つにしか(2)のマクロが動きません。 下記のコードの間違いを教えてください。 Sub 契約書目次印刷() Dim Sh As Worksheet Dim t As Long Dim i As Range t = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'データーのあるシートだけ印刷 For Each Sh In Worksheets(Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14)) If Sh.Range("A2").Value <> "" Then '連続データーセル結合 For Each i In Range("C1:C" & t) If i.MergeArea(1).Value = i.Offset(1).Value Then Range(i.MergeArea, i.Offset(1)).Merge End If Application.DisplayAlerts = False Next i End If Sh.PrintPreview Next Sh End Sub

  • マクロに手を加えたいのですが・・・・・

    マクロに手を加えたいのですが・・・・・ 下記のマクロの式があるのですが、全シートの　ＡＫ８にデーターが０以上だったら 指定の範囲のデーター週払い一覧にコピーしなさいと、　書いてあるのだと おもうのですが・・・　（素人なので、分かりませんが） これだと　１件だけ要らないデーターを読みこんでしまいます。 色んなシート名が有りますが、　欲しいデータのあるシート名は、 必ずSheet番号となっているので、 Sheet１～Sheet５０までのデーターから　（シートNOは、増えたりします） Sheetの名前から　始まる等の指定をしたいのですが、 どのように　書き換えればよろしいでしょうか、 Sub test() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "週払一覧" Then With Worksheets("週払一覧") If Sh.Range("AJ８").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("AB3:AK8").Copy .Cells(1) .Resize(6, 10).Value = Sh.Range("AB3:AK8").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub 私の勘ですが(笑)　If Sh.Range("AJ８").Value > 0 Thenの IF　Sｈを　If　ｓｈ""　とか　Sh（"　"）　とか　Sh（i）とか＠とか やりましたが　、できませんでした、 初歩的な事でしょうが、　教えてください お願いします。

  • マクロの式について教えてください！

    マクロの式について教えてください！ 他で使っていたマクロを書き換えて流用してますが、 エラーなどの表示は、出ないのですが、動きません。 考えられる問題を　教えてください。 おねがいします。　下のような式をつかってます。 Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("H5").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("L1:T5").Copy .Cells(1) .Resize(5, 9).Value = Sh.Range("L1:T5").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub おねがいします。

  • VBAの表からシートを作成したい

    現在の構文は以下のようになっています。 Dim ws As Range For Each ws In Worksheets("ユーザー情報").Range("C2:C201") On Error GoTo myError If Not ws Is Nothing Then Worksheets("雛形").Copy After:=Worksheets(Worksheets.Count) ActiveSheet.name = ws.Value End If Next ws Exit Sub myError: nm = "雛形 (2)" For Each sh In Worksheets If sh.name = nm Then Application.DisplayAlerts = False Worksheets(nm).Delete Application.DisplayAlerts = True End If Next 「ユーザー情報」シートのC列に氏名を記入して上記マクロを実行すれば、その氏名ごとに「雛形」を元にしたシートが連続でコピーされる形になっています。 しかし、1度実行した後、あらたにC列に氏名を追加してもその分のコピーを作ってくれなくなります。 どのようにすればよいでしょうか。アドバイスをいただければと思います。

  • エクセル2000VBA　情報の検索について

    いつもお世話になります。 sheet1は商品情報検索画面で、sheet2は、データのマスターです。 sheet1のセル"D4"に商品コードを入力し、マクロを起動することで、sheet2の商品コード（A列）の同じ情報を検索し、その次のセルの商品コードを表示させたいのです。（ややこしくてすみません） 自分なりに考えてコードを作ってみたのですが・・・ Dim sh2, sh3 As Worksheet Dim temp As Variant Set sh2 = Worksheets("sheet2") Set sh3 = Worksheets("sheet1") d = sh2.Range("A1").CurrentRegion.Rows.Count Set temp = sh2.Range("A2:A" & d).Find(What:=sh3.Range("D4").Value) For l = 2 To d If Not temp Is Nothing Then sh3.Range("D4").Value = sh2.Cells(l, 1).Offset(1, 0).Value ElseIf temp Is Nothing Then sh3.Range("D4").Value = sh2.Range("A2").Value End If Next l 以上だと、次々に情報が更新され、結局最終行の空白が答えになってしまいます。 以上宜しくお願い致します。

  • ＶＢＡ　なんですが

    ＶＢＡ　なんですが すべてのワークシートを順番に選択して 指定した範囲をコピーし『まとめ』と言う別のシートに貼り付けたいのですが どうしたらいいのかわかりません。 それらしいのは考えたのですが Set sh = Worksheets(sh.Name)でエラーになります。 頭がいいかた教えてください。 　　Dim sh3 As Worksheet Dim sh As Worksheet Dim en As Long Set sh3 = Worksheets("まとめ") For Each sh In ActiveWorkbook.Worksheets If sh.Name <> "まとめ" Then en = sh.UsedRange.Rows.Count Set sh = Worksheets(sh.Name) sh.Range(Cells(2, 1), Cells(en, 10)).Copy

  • ThisWorkBookモジュールとSheetモジュールの両立

    エクセル２００３でマクロを組んでいます。 Sheet1,Sheet2の２つのシートがあり、 片方のシートの"A4:G10"の範囲に値を書き込むと、もう片方の同じ位置に同じ値が書き込まれるようなマクロを組みたいです。 以前ここで教えていただいたものを改変して以下を作りました（ThisWorkBookモジュールです）。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim r As Range Dim Num As Integer Dim S As String, Sh_name As String Sh_name = ActiveSheet.Name Set r = Intersect(Target, Range("A4:G10")) If Not (r Is Nothing) Then Application.EnableEvents = False For Num = 1 To 2 S = "Sheet" & Num If S <> Sh_name Then Worksheets(S).Range(r.Address).Value = r.Value End If Next Application.EnableEvents = True End If End Sub ここまでは正常に動作します。 また、 Sheet1とSheet2のモジュールに、 A列のセルに値が入力された場合、同じ行のC列のセルの色を塗るという記述をしています。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Cells(Target.Row, 3).Interior.ColorIndex = 5 End If End Sub これらを同時に生かしたいのですが、 どのように書けばいいでしょうか。 EnableEvents = False／Trueを消してしまうと、 Worksheets(S).Range(r.Address).Value = r.Valueが実行されるたびにThisWorkBookモジュールが動いているようです。 そして2回目のSet r = Intersect(Target, Range("A4:G10"))でエラーが出ます。 （エラーは出ずとも延々と(無限ではない回数)ThisWorkBookモジュールを繰り返したコードもありました。） よろしくお願いします。

  • マクロの質問です。下記の式があるのですが、コピーしたい、セルには、文字

    マクロの質問です。下記の式があるのですが、コピーしたい、セルには、文字や計算式、又は他のセルから参照させてる物もあるので、張り付けたものに、エラーが数多く表示されるのですが、 コピー元の表示されてる文字を　張り付けることは、できるのでしょうか、 よろしくお願いします。 Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("I14").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("O2:X14").Copy .Cells(1) .Resize(6, 10).Value = Sh.Range("O2:X14").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub

  • VBAですべてのワークシートを処理したい

    ブック内の全ワークシートに対して同じ処理をするために、 For each ワークシート in Worksheets ～処理～ Next ワークシート を使ってみたのですが、その時にアクティブになっているシートしか処理されません。たとえば次のようなシンプルなコードでも、同様です。何が抜けているのでしょうか。 Sub allworksheets() Dim WS As Worksheet For Each WS In Worksheets Range("a1") = "123" Next WS End Sub マクロの勉強を始めたばかりで、基本的なことでつまづいてます。よろしくお願い致します。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する