2つの条件を同時に満たすと図形を別のワークシートにコピーし、600行程度あるワークシートなので For - Next を使ってその作業を繰り返す、というエクセルのマクロを以下のように書き込みました。ところがマクロを実行すると、一番最初の行だけ正確に実行され、次に条件を満たす行があっても図形がコピーされません。(ということはカウンター i, j の使い方が間違っているのです)どなたか私の素人コードを見て修正方法を教えてください。お願いします。
Sub finalize()
Dim MyStr As String
Dim i As Long
Dim j As Long
For j = 2 To 1482 Step 40
For i = 3 To 188 Step 5
MyStr = Range("O" & i)
If MyStr <> "" Then '条件1
If Range("L" & i).Value = "毎日" Then '条件2
Sheets("図形_現読").Select
ActiveSheet.Shapes.Range(Array("毎日")).Select
Selection.Copy
Sheets("印刷画面").Select
Range("AG" & j).Select
ActiveSheet.Paste
Else
If Range("L" & i).Value = "朝刊" Then
Sheets("図形_現読").Select
ActiveSheet.Shapes.Range(Array("朝刊")).Select
Selection.Copy
Sheets("印刷画面").Select
Range("AG" & j).Select
ActiveSheet.Paste
End If
End If
End If
Next i
Next j
End Sub
No.8ベストアンサー
- 回答日時:
回答2です。
次のようにするとよいでしょう。表が入力されているシート(シート1とします)、図形の入力されているシート、表のデータに基づいて図形を貼り付ける印刷用のシートが有るのでしょうか、そのようにして対応するとします。
Sub finalize()
Dim MyStr As String
Dim i As Long
Dim j As Long
Set WS1=Sheets("Sheet1")
Set WS2=Sheets("図形_現読")
Set WS3=Sheets("印刷画面")
Application.ScreenUpdating = False
j = 2
For i = 3 To 188 Step 5
MyStr = WS1.Range("O" & i)
If MyStr = "" Then Exit For '条件1
If WS1.Range("L" & i).Value = "毎日" Then '条件2
WS2.Select
ActiveSheet.Shapes.Range(Array("毎日")).Select
Selection.Copy
WS3.Select
WS3.Range("AG" & j).Select
ActiveSheet.Paste
j = j + 40
End If
If WS1.Range("L" & i).Value = "朝刊" Then
WS2.Select
ActiveSheet.Shapes.Range(Array("朝刊")).Select
Selection.Copy
WS3.Select
WS3.Range("AG" & j).Select
ActiveSheet.Paste
j = j + 40
End If
Next i
Application.ScreenUpdating = True
End Sub
お礼が遅れてすみません(今日も一日仕事だったもので。)今自宅に戻って早速試しました。残念ながら同じ結果でした。でもいろいろと教えてくださってありがとうございました。書いてくださったコードは大事にとっておいて再利用させていただきます。もう少し繰り返しコードの基礎的な事を自習して、再度チャレンジします。
No.7
- 回答日時:
>一番最初の行だけ正確に実行され、次に条件を満たす行があっても図形がコピーされません。
⇒多分、標準モジュールで登録しているとプロシージャ内でシート選択するとシートオブジェクトを指定しないコードはそのシートで認識する為、1行目だけ動作することになりますのでご注意ください。
因みに変数jはiループが終わるまで同一ですのでご注意ください。
シート選択しないでコピーできる一例です。(コードが冗長なのでダイエットしています)
データシートを選択した状態でマクロ実行してください。
Sub finalize()
Dim i As Long
Dim j As Long
j = 2
For i = 3 To 188 Step 5
If Range("O" & i) <> "" Then
If Range("L" & i) = "毎日" Or _
Range("L" & i) = "朝刊" Then
Sheets("図形_現読").Shapes(Range("L" & i)).Copy
ActiveSheet.Paste Sheets("印刷画面").Cells(j, "AG")
End If
End If
j = j + 40
Next i
End Sub
お礼が遅くなってすみませんでした。実は数々の回答を試したのですが全然うまくいかず、あきらめて何度も投稿してくださった方の回答をベストアンサーに選んでしまいました。そしてすぐ後にこのコードをコピーして試したらナント成功しました。本当にありがとうございます。そしてベストアンサーに選び損ねたことをお詫び申し上げます。
No.6
- 回答日時:
見辛いので整形とイミディエイトウィンドウにシート名を出力するようにしただけです。
Tab インデントの代わりに全角スペースにしていますのでエラーになるかも。
手掛かりにはなるかと。
Sub finalize()
Dim MyStr As String
Dim i As Long
Dim j As Long
For j = 2 To 1482 Step 40
For i = 3 To 188 Step 5
MyStr = Range("O" & i)
Debug.Print MyStr, Range("O" & i).Parent.Name
If MyStr <> "" Then '条件1
Debug.Print Range("L" & i).Parent.Name
If Range("L" & i).Value = "毎日" Then '条件2
Sheets("図形_現読").Range(Array("毎日")).Copy _
Destination:=Sheets("印刷画面").Range("AG" & j)
ElseIf Range("L" & i).Value = "朝刊" Then
Sheets("図形_現読").Range(Array("朝刊")).Copy _
Destination:=Sheets("印刷画面").Range("AG" & j)
End If
End If
Next i
Next j
End Sub
お礼が遅くなってすみません。コードをコピーして試しましたが、最期の図形のコピーの部分でエラーがでました。でも書いてくださったコードは大事に保管して再利用させていただきます。もう少し基礎的な事を自習してから再度チャレンジするつもりです。ありがとうございました。
No.5
- 回答日時:
#4です。
>シートを元に戻すコードを加えると、図形の貼り付けが無限にしかも条件に即しない箇所にも起こってエラーになります。
プログラムを見ると、
1つの行で条件1、条件2を満たすと、図形を38回貼り付けしています。
だから、もし10の行で条件を満たせば380回貼り付けすることになります。
そのような仕様なのでしょうか?
エラーの原因はメモリー不足でしょう。
お礼が遅くなってすみません。今朝いただいた回答の中に1つだけうまく実行できたコードがありました。もう少し基礎的な事を自習して、次回は自分が書くコードの意味をよくわかってから質問します。お休みの日にどうもありがとうございました。
No.4
- 回答日時:
Sheets("図形_現読").Select
や
Sheets("印刷画面").Select
でアクティブシートを変えていますが、
Range("O" & i)やRange("L" & i)はどのシートのRangeなんでしょうか?
もしこれが"印刷画面"シートなら問題ないですが、そうでなければループの最初または最後にアクティブシートを元に戻しておかなければなりません。
この回答への補足
シートを元に戻すコードを加えると、図形の貼り付けが無限にしかも条件に即しない箇所にも起こってエラーになります。シートを指定するコードの挿入場所を変えていくつか試しましたが、全く変化なし、もしくは無限なコポー&貼り付けでエラー、という結果になります。
補足日時:2012/09/16 08:22お礼が遅くなってすみません。今朝いただいた回答の中から、1つだけうまく実行できたコードがありました。次回はもう少し自習をしてからコードを書くように心がけます。ありがとうございました。
No.3
- 回答日時:
回答2は無視してください。
次のようにコードを変えてみてはどうでしょう。
Sub finalize()
Dim MyStr As String
Dim i As Long
Dim j As Long
j = 2
For i = 3 To 188 Step 5
MyStr = Range("O" & i)
If MyStr <> "" Then '条件1
If Range("L" & i).Value = "毎日" Then '条件2
Sheets("図形_現読").Select
ActiveSheet.Shapes.Range(Array("毎日")).Select
Selection.Copy
Sheets("印刷画面").Select
Range("AG" & j).Select
ActiveSheet.Paste
j = j + 40
Else
If Range("L" & i).Value = "朝刊" Then
Sheets("図形_現読").Select
ActiveSheet.Shapes.Range(Array("朝刊")).Select
Selection.Copy
Sheets("印刷画面").Select
Range("AG" & j).Select
ActiveSheet.Paste
j = j + 40
End If
End If
End If
Next i
End Sub
この回答への補足
ありがとうございます。言われた通りに試しましたが同じ結果でした。Exit For を使ってEnd If を一個削除することも試しましたが、やはりだめでした。最初練習するとき同じワークシート内で、カウンター i だけつかって(step は無)でマクロを書き、試したらうまくいきました。そしてそのマクロにカウンター j を追加し、ワークシートを変える操作を加えただけなんですけど、、、おそらく繰り返し操作のコードの書き方がまちがっていると思います。もう少し頑張ります。ありがとうございました。
補足日時:2012/09/16 08:31No.2
- 回答日時:
次のように一部を変更して試験してみてください。
If MyStr <> "" Then は
If MyStr <> "" Then Exit For
End If は一つを削除します。
No.1
- 回答日時:
デバックしましたか?
F8でステップデバックしてみてください。
人のプログラム検証デバック面倒くさいので、ローカルウィンドウ、イミディエイトウィンドウ、ウオッチウィンドウ表示させておけば、カウンタの中身みれすでしょ。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ExcelのVBAのマクロで他のシー...
-
特定の文字を含むシートだけマ...
-
【ExcelVBA】全シートのセルの...
-
ブック名、シート名を他のモジ...
-
ユーザーフォームに入力したデ...
-
シートが保護されている状態で...
-
VBA 存在しないシートを選...
-
エクセルのシート名変更で重複...
-
excelのマクロで該当処理できな...
-
VBA 最終行まで数式をコピーする
-
VBA 入力月で該当シートを選択...
-
Excel VBA リンク先をシート...
-
実行時エラー'1004': WorkSheet...
-
Excel VBA 文字列のセルを反映...
-
マクロを使って、シート印刷完...
-
VBA 検索して一致したセル...
-
エクセルVBA Ifでシート名が合...
-
別のシートから値を取得するとき
-
VBAで指定シート以外の選択
-
トグルボタン一部を一度にON OF...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
特定の文字を含むシートだけマ...
-
excelのマクロで該当処理できな...
-
【ExcelVBA】全シートのセルの...
-
ユーザーフォームに入力したデ...
-
別のシートから値を取得するとき
-
ブック名、シート名を他のモジ...
-
実行時エラー'1004': WorkSheet...
-
Excelマクロのエラーを解決した...
-
XL:BeforeDoubleClickが動かない
-
シートが保護されている状態で...
-
エクセルのシート名変更で重複...
-
実行時エラー1004「Select メソ...
-
VBAで同じシート名のコピー時は...
-
エクセルで通し番号を入れてチ...
-
同じ作業を複数のシートに実行...
-
Excel VBA リンク先をシート...
-
ExcelのVBAのマクロで他のシー...
-
Vba UserformからExcelシートの...
-
【Excel VBA】Worksheets().Act...
-
VBA 存在しないシートを選...
おすすめ情報