• ベストアンサー

Excel VBA For Each Next構文内の別シートを対象とする方法

こんにちは。 VBA初心者のものですが教えてください。 「sheet1のC29:U29とsheet2のC31:G31について 1より小さければ小数第2位まで表示する」 の構文を作成したいのですが、 下記の構文ではエラーが出てしまいました。 どのように訂正すればよいでしょうか? ※できればrangeプロパティを使いたいのですが、  cellsプロパティを使わなきゃできませんか? すみませんがご教示をお願いいたします。 Sub test() Dim myrange As Range For Each myrange In Worksheets("sheet1").Range("C29:U29"),Worksheets("sheet2").Range("C31:G31") If myrange.Value < 1 Then myrange.NumberFormatLocal = "0.00" End If Next myrange End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.4

こんばんは。 一般的に、同種のオブジェクトを確保する場合は、Collection に格納します。ただし、c にエラー値が入っていないことが条件です。 '------------------------------------------- Sub RngPlus()   Dim colRng As Collection   Dim rng As Range   Dim c As Range      Set colRng = New Collection      colRng.Add Worksheets("Sheet1").Range("C29:U29")   colRng.Add Worksheets("Sheet2").Range("C31:G31")      For Each rng In colRng     For Each c In rng       If c.Value < 1 Then         c.NumberFormatLocal = "0.00"       End If     Next c   Next rng End Sub

raymay0905
質問者

お礼

お礼が遅くなりまして申し訳ありません。 ご回答ありがとうございました。 設定範囲のシートはもっと増える予定ですので、 ご紹介いただいた方法を今後活用したいと思います。

その他の回答 (5)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.6

#4の回答者です。 回答した後に考え直してみたけれども、テクニックとしてはいくつか存在はしていても、できなければ、同じものを二つ書くか、サブルーチンにすればよいのではないでしょうか。私の#4に書いた方法などは、使う必要がないと思います。 >If myrange.Value < 1 Then >myrange.NumberFormatLocal = "0.00" それと、1 以下なら、書式を0.00と換えるというのは意味がないのでは? 1以下は、0.1もありますが、-1もTrue が返ります。 たとえば、小数点がある場合とかにしたら良いと思います。 '------------------------------------------- Sub Main() Test Worksheets("sheet1").Range("C29:U29") Test Worksheets("sheet2").Range("C31:G31") End Sub Sub Test(rng)   Dim myRange As Range   For Each myRange In rng     If myRange.Value - Int(myRange.Value) <> 0 Then       myRange.NumberFormatLocal = "0.00"     End If   Next myRange End Sub

raymay0905
質問者

お礼

お礼が遅くなりまして申し訳ありません。 何度もご回答ありがとうございました。 設定範囲のシートは2つだけではないので、 できれば分ける方法ではなく 手軽に増やせる方法が適していると考えています。 また、本件ではマイナス値は取り扱わない状況なので、 INT関数は考慮しなくても大丈夫です。 #4でご紹介いただいた方法を活用したいと存じます。

  • hotosys
  • ベストアンサー率67% (97/143)
回答No.5

手っ取り早くarrayで外側にもう一つループを作る場合です。 Sub test() Dim rng As Variant Dim myrange As Range For Each rng In Array(Worksheets("sheet1").Range("C29:U29"), Worksheets("sheet2").Range("C31:G31")) For Each myrange In rng If myrange.Value < 1 Then myrange.NumberFormatLocal = "0.00" End If Next myrange Next rng End Sub

raymay0905
質問者

お礼

お礼が遅くなりまして申し訳ありません。 ご回答ありがとうございました。 設定範囲のシートはもっと増える予定ですので、 ご紹介いただいた方法を今後活用したいと思います。

回答No.3

>For Each myrange In Worksheets("sheet1").Range("C29:U29"),Worksheets("sheet2").Range("C31:G31") こういう書き方は出来ません。別シートですからUnionも使えませんね。「Worksheets("sheet1").Range("C29:U29")」と「Worksheets("sheet2").Range("C31:G31")」との2回に分けるのが素直なやり方です。 実は設定範囲がもっとたくさんある、というのなら、 ・Rangeを配列に格納する ・桁設定をサブルーチンにしておく ことで、For文で回してはどうでしょう。 Sub test() Dim rs(0 To 1) As Range, i As Integer Set rs(0) = Worksheets("sheet1").Range("C29:U29") Set rs(1) = Worksheets("sheet2").Range("C31:G31") For i = 0 To UBound(rs) ケタ設定 rs(i) Next End Sub Sub ケタ設定(r As Range) Dim c As Range For Each c In r If c.Value < 1 Then c.NumberFormatLocal = "0.00" End If Next End Sub

raymay0905
質問者

お礼

お礼が遅くなりまして申し訳ありません。 ご回答ありがとうございました。 ご指摘の通り、設定範囲はもっと増える予定ですので、 ご紹介いただいた方法を今後活用したいと思います。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

同一シートなら Sub test() Dim myrange As Range Set x = Union(Worksheets("sheet1").Range("A1:B2"), Worksheets("sheet1").Range("D1:E3")) For Each myrange In x MsgBox myrange Next myrange End Sub ができる。 ーー しかし http://support.microsoft.com/kb/291308/ja の15:22 つ以上の指定した範囲を選択する方法 にあるように、「Union メソッドはシートを越えて使用することはできません。」のです。 Sub test() Dim myrange As Range Set x = Union(Worksheets("sheet1").Range("A1:B2"), Worksheets("sheet2").Range("D1:E3")) For Each myrange In x MsgBox myrange Next myrange End Sub はエラー。 Sub test() Dim myrange As Range Set x = Union(Worksheets("sheet1").Range("A1:B2"), Range(sh2range)) For Each myrange In x MsgBox myrange Next myrange End Sub もエラー。 Range(sh2range)のsh2rangeは範囲名定義。 ーーー シートごとの範囲にFor Each Nextを使うほか無いと思う。 Unionメソッドは初心者には超えた課題かと思う。

raymay0905
質問者

お礼

お礼が遅くなりまして申し訳ありません。 ご回答ありがとうございました。 やはりシートごとに分けるのが一番無難な方法ですね。

  • xls88
  • ベストアンサー率56% (669/1189)
回答No.1

sheet1とsheet2のFor Each文を分けて記述してみてください。

raymay0905
質問者

お礼

お礼が遅くなりまして申し訳ありません。 ご回答ありがとうございました。 入門レベルには一番優しい方法ですね。

関連するQ&A

  • Excel VBA For Each~Next構文についての質問

    こんにちは。 VBA初心者のものですが教えてください。 ※Excel2003です 「Sheet2のC29:U29のセルについて 1より小さければ小数第2位まで表示 1以上であれば小数第1位まで表示」 の構文を作りたいのですが、 「実行時エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません」 のエラーが出てしまい、実行できません。 作成した構文は以下の通りですが、どのように訂正すればよいか、 ご教示いただけますでしょうか。 よろしくお願いいたします。 Sub ケタ() ' Dim rngCell As Range For Each rngCell In Worksheets("Sheet2").Range("C29:U29") If rngCell.Value < 1 Then rngCell.Selection.NumberFormatLocal = "0.00" Else rngCell.Selection.NumberFormatLocal = "0.0" End If Next rngCell End Sub

  • 別のシートにあるリストを表示する方法

    すみません 検索シートから生徒シートの名前を検索したら検索シートに返されるようなマクロはどの様に書けばいいでしょうか? イメージとしては下記のような感じです。できれば左2行目3行目の検索結果も返したいです。 よろしくお願い致します。 Sub 名前検索() Dim myrange As Range Worksheets("生徒シート").Activate Set myrange = Range("C4:AG300").Find(what:=Range("C100").Value, LookIn:=xlValues) If Not myrange Is Nothing Then Worksheets("検索シート").Activate Cells(102, "C").Value = myrange.Offset(, -3).Value Else MsgBox "該当者なし" End If End Sub

  • Excel VBA 構文をすっきりさせたい

    いつもお世話になっています。 次のような構文を使って、データを別シートに転送するVBAを作成しました。 転送するデータが多い場合、構文が延々続くことになります。 もっとすっきりと記述する方法がありましたらぜひ教えてください。 お力添え、よろしくお願いします。 Sub データ() With ActiveSheet Dim last last = ActiveSheet.Range("b" & Rows.Count).End(xlUp).Row + 1 .Range("b" & last).Value = Worksheets(2).Range("b2").Value .Range("c" & last).Value = Worksheets(2).Range("c2").Value .Range("d" & last).Value = Worksheets(2).Range("d2").Value     以下同様に続く・・・・ End With End Sub

  • For Each ~ Nextステートメント

    今、1つのブックに200前後のワークシートがあるとします。 For Each ~ Nextステートメントを使って以下のようなプログラムを全てのワークシートに適用したいと考えています。 Sub test() Dim mySht As Worksheet For Each mySht In Worksheets If Range("A2").Value <> "1990/01/31" Then Rows("2:2").Select Selection.Insert Shift:=xlDown Range("A2").Select ActiveCell.FormulaR1C1 = "1990/01/31" End If If Range("A3").Value <> "1990/02/28" Then Rows("3:3").Select Selection.Insert Shift:=xlDown Range("A3").Select ActiveCell.FormulaR1C1 = "1990/02/28" End If ・・・(中略)・・・ Next End Sub しかし、これを実行しても、うまくいきません。 全てのワークシートについて、必ずしもA2のセルが 1990/01/31であるとは限らないことが原因かとは思うんですが、自身ではどうしてもうまくプログラムを書くことが できません。良いお知恵を拝借できればと思います。

  • for~Next 構文の間に処理を追加したい。

    for~Next 構文の間に処理を追加したい。 ちょっと必要に迫られまして、他人の作ったEXCELマクロをいじらないといけなくなったのですが、小生初心者でどうもうまくいきません。 sheet1に条件を入れて、sheet2のセルに表示された内容をラベルに印刷するというプログラムなのですが、 PrintColum = Worksheets("sheet1").Range("L5").Value MaxGyou = Worksheets("sheet1").Range("L4").Value Maxrow = Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Row Gyou = 1 + Worksheets("sheet1").Range("A3").Value Keta = 1 Worksheets("sheet2").Activate For k = 5 To Maxrow Hiduke = Worksheets("sheet1").Range("A" & k).Value ID = Worksheets("sheet1").Range("B" & k).Value Koumoku = Worksheets("sheet1").Range("C" & k).Value Kishaku_Min = Worksheets("sheet1").Range("D" & k).Value Kishaku_Max = Worksheets("sheet1").Range("E" & k).Value Maisu = Worksheets("sheet1").Range("F" & k).Value blank = Worksheets("sheet1").Range("G" & k).Value For i = Kishaku_Max To Kishaku_Min Step -1 For j = 1 To Maisu Keta = Keta + 1 Worksheets("sheet2").Range("A1").Cells(Gyou, Keta + 1).Value = " " & Hiduke & " " & ID & Chr(10) & " " & Koumoku + " 10^" + CStr(i) GyouHyouji = Worksheets("sheet2").Range("A1").Cells(Gyou, 1).Row Worksheets("sheet2").Range("A1").Cells(Gyou, 1).Value = (GyouHyouji - 1) Mod MaxGyou + 1 If Keta > PrintColum Then Keta = 1 Gyou = Gyou + 1 End If Next j Next i Next k Next i の処理が終了したとき、blankの値が"1"なら、ひとつだけ内容の違うセルを差し込みたいと考えています。 わかる範囲でいろいろ試したのですが、まったくうまくいきません。 どなたかお知恵を拝借できないでしょうか?

  • Excel VBAの「FOR~NEXT関数」について

    VBAを初めて2ヶ月の超初心者です。 シートが2枚あり、sheet1は仕入金額一覧、sheet2は送付案内書になっています。VBAを利用して「sheet1から1行、sheet2へ転記し印刷後、次の行へ」と言う処理をしています。 Sub 送付案内() Dim 行番号 As Integer For 行番号 = 5 To 298 If Cells(行番号, 15).Value = 1 Then Range(Cells(行番号, 2), Cells(行番号,12).Select Selection.Copy Sheets("送付案内").Select Range(Cells(60, 1), Cells(60, 11)).Select ActiveSheet.Paste Application.CutCopyMode = False Worksheets("送付案内").PrintOut Sheets("作業").Select End If Next End Sub Sub 仕入先名() Dim 行番号 As Integer For 行番号 = 5 To 298 Sheets("作業").Cells(行番号, 2) = WorksheetFunction.VLookup(Cells(行番号, 1), Sheets("仕入先マスタ"). _ Range("$A$3:$B$1135"), 2, False) Next End Sub これでVBAを実行した場合、仕入金額一覧の並び順と微妙(2~3点)に異なる順番で印刷されました。仕入先名や仕入金額に間違いはありませんでした。 同様の経験のある方等、原因がわかる方がいらしたら、教えてください。よろしくお願いします。

  • エクセルVBA 1つのシートで出来ますか?

    説明が下手で申し訳ございませんが、宜しくお願い致します。 sheet(1)に20個のボタンがあります。 ボタンをクリックすると、別のシートが開きます。 開いたシートにも複数のボタンがあり、そのうちの任意のボタンをクリックすると、そのボタンの値がsheet(1)のそれぞれのボタンに対応したセルに入力される、という動作を実現したいと思っています。 現状、下記のようなコードで目的の動作は実現できてはいるのですが、各ボタンそれぞれにシートを作っているような状況です。(データ自体は全く同じ内容のものが、計20シート) たぶん、もの凄く頭の悪い事をやっているんだろうと思います。 sheet(1)を除いた各シートの入力データ自体は全く同じなので、シート一枚で出来るんじゃないのかなと思い、ネットや本で調べながら色々試してみたのですが、どうも上手く行きません。データが同じでも、sheet(1)のクリックしたボタンによって入力するセルを変えなければならないのが問題です。 sheet(1)のボタンとセルの関連付けや、sheet(1)のどのボタンを押したのかの判別ができればいいのかなと思って調べてみても、初心者にはよく理解できず、もう何週間もチャレンジしているのですがお手上げです。 上級者の方の知恵をお借りできれば幸いです。 Sub sheet2を開く() Worksheets(2).Select End Sub Sub 入力1() Worksheets(1).Range("F8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("F8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("F8") = "データ3" Worksheets(1).Select End Sub Sub sheet3を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("H8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("H8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("H8") = "データ3" Worksheets(1).Select End Sub Sub sheet4を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("M8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("M8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("M8") = "データ3" Worksheets(1).Select End Sub    ・    ・    ・    ・    ・

  • エクセルVBAで別シートにコピー貼り付け

    VBA初心者です。下記のようにプログラムしましたがうまくいかなくて困ってます。どなたかお力をお貸しください。内容としましては輸入Partsのシートからコピーして商品内容確認のシートのセルB17に貼り付けたいです。輸入Partsシートで3列目の空白を探し同じ行の1列目をコピーします。商品内容確認のシートのセルB17にはカーソルは動いているようですが貼りつきません。 Private Sub 商品内容確認2_Click() If MsgBox("商品内容確認へ移動しますか?", 33, "移動の確認") = 2 Then MsgBox "処理を中止します。" Range("A2").Select Exit Sub End If Dim Line As String Dim Maxrow As String Worksheets("輸入Parts").Select Line = 2 Do Until Cells(Line, 1).Value = "" On Error Resume Next If Cells(Line, 3).Value = "" Then Cells(Line, 1).Copy 'コピーする Maxrow = Worksheets("商品内容確認").Range("B17").End(xlDown).Row + 1 Worksheets("商品内容確認").Range("B" & Maxrow).PasteSpecial Paste:=xlPasteValues '値を貼り付け End If On Error GoTo 0 '次の行に移り最後の行まで検索 Line = Line + 1 Loop Worksheets("商品内容確認").Visible = True Worksheets("商品内容確認").Select Worksheets("商品内容確認").Range("B6").Select Worksheets("商品内容確認").輸入Partsシート2.Visible = True Worksheets("商品内容確認").輸出Partsシート2.Visible = False Worksheets("輸入Parts").Visible = False End Sub

  • エクセル VBA シートの選択 

    windows XP でエクセル2000を使っています。 Sub aaa() Sheets("Sheet1").Select Dim a As String a = Cells(2, 4) Sheets(a).Select Range("A1").Select End Sub というマクロだと セルに入っている値のシート名を探してくれます。 ですが Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value Dim b As String b = Range("C2).value (←ここをcellsにしてもダメ) Sheets(b).Select Range("A1").Select End Sub これだとsheets(b)を選びません。Sheets(b).Selectのところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。

  • 別のシートを参照して計算する方法

    質問です。 シート1に数値が入力してあり、そこで計算した結果をシート2に貼り付けるにはどのようにすればいいのでしょうか? Worksheets("シート2").Cells(3 + g, 3 * c) = _ Worksheets("シート1").Select.WorksheetFunction._ Average(Range(Cells(e, g + 2), Cells(f, g + 2))) と書いたのですが、上手くいきません。 おそらく Worksheets("シート1").Select.WorksheetFunction._ Average(Range(Cells(e, g + 2), Cells(f, g + 2))) の部分がおかしいと思うのですが、どうすればよいでしょうか? よろしくお願いします。

専門家に質問してみよう