Excel VBA質問箱 IV

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

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


8787 / 13644 ツリー ←次へ | 前へ→

【31177】条件に合った処理を行ったら終了させるには? ひよ 05/11/14(月) 10:48 質問[未読]
【31179】Re:条件に合った処理を行ったら終了させる... 05/11/14(月) 10:57 発言[未読]
【31189】Re:条件に合った処理を行ったら終了させる... ひよ 05/11/14(月) 13:09 質問[未読]
【31192】Re:条件に合った処理を行ったら終了させる... 05/11/14(月) 13:34 回答[未読]

【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が0〜3個あり、
その中でSUMI1も一致するところのみ処理を行いたく、
どうにかそれは出来たのですが、
ずっと終わらなくなってしまいました。
これが無限ループというものでしょうか?

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

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

【31179】Re:条件に合った処理を行ったら終了させ...
発言    - 05/11/14(月) 10:57 -

引用なし
パスワード
   こんにちは。
ループから抜け出したいのですよね?
辞めたいところに「Exit For」をいれてあげると
終わると思います。

【31189】Re:条件に合った処理を行ったら終了させ...
質問  ひよ  - 05/11/14(月) 13:09 -

引用なし
パスワード
   こんにちは!
早速の返信ありがとうございます!

ど素人ですみません、、、
貼り付けの後にExit Forを入れてみたら、
そこから下には行かなくなったのですが、また上に戻って、
それを繰り返すようになってしまいました;_;

辞めたいところは、貼り付け後なのですが、
VBAの中でそれがどこなのかわかりません。
ここかも、ってところには入れてみたんですが。。

【31192】Re:条件に合った処理を行ったら終了させ...
回答    - 05/11/14(月) 13:34 -

引用なし
パスワード
   Option Explicit

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
>  Exit For
  Else
  BUHIN.Activate
  End If
Next BUHIN

End Withのあとにつけると終わると思います。
(貼付後にいれてみました。)

8787 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free