Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

50444 / 76732

←次へ　｜　前へ→


	【31177】条件に合った処理を行ったら終了させるには？

ひよ - 05/11/14(月) 10:48 -


	引用なし

	パスワード

はじめまして。初心者です。
わけもわからず手探り状態で書いてます。
とりあえず途中までは意図通り動いてくれたのですが、
行き詰まりました。
きっと難しいことではないのだと思うのですが、
いろいろ調べても見つけられませんでした。。。
どなたか教えていただけませんか？

やりたい事は、
FILEのD列にKAIRO1があって、かつその隣E列にはSUMI1があるところを見つけて、
その行のPQ列に、データ入力macro.xlsの値と貼り付け、
貼り付けが終わったら終了。

Sub ためし()

　　　　FILE = Workbooks("データ入力macro.xls").Sheets("実施").Range("C11")
　　　　KAIRO1 = Workbooks("データ入力macro.xls").Sheets("実施").Range("B21")
　　　　SUMI1 = Workbooks("データ入力macro.xls").Sheets("実施").Range("C21")
　　　　Dim BUHIN As Range
　　　　
　　　　Windows(FILE & ".xls").Activate
　　　　
　　　　For Each BUHIN In Range("D5:D37")
　　　　　If BUHIN = KAIRO1 Then
　　　　　　 BUHIN.Activate
　　　　　　　Arow = ActiveCell.Row
　　　　　　 With Worksheets(1).Range("E" & Arow)
　　　　　　　　　Set SUMI = .Find(SUMI1, LookIn:=xlValues)
　　　　　　　　If Not SUMI Is Nothing Then
　　　　　　　　　　Workbooks("データ入力macro.xls").Sheets("実施").Range("D21:E21").Copy
　　　　　　　　　　Windows(FILE & ".xls").Activate
　　　　　　　　　　Worksheets(1).Select
　　　　　　　　　　Range("P" & Arow).Select
　　　　　　　　　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
　　　　　　
　　　　　　　　End If
　　　　　　 End With
　　　　　Else
　　　　　　　BUHIN.Activate
　　　　　End If
　　　　Next BUHIN
End Sub

FILEには、KAIRO1が０～３個あり、
その中でSUMI1も一致するところのみ処理を行いたく、
どうにかそれは出来たのですが、
ずっと終わらなくなってしまいました。
これが無限ループというものでしょうか？

D5:D37すべて見てから終了でもいいのですが、
KAIRO1もSUMI1も一致するものは、０個か１個なので、
条件に一致するものを見つけて貼り付けが終わったら終了させたいです。

拙い説明ですみません。
宜しくお願いします。

0 hits

▼

【31177】条件に合った処理を行ったら終了させるには？ ひよ 05/11/14(月) 10:48

≪