| |
はじめまして。初心者です。
わけもわからず手探り状態で書いてます。
とりあえず途中までは意図通り動いてくれたのですが、
行き詰まりました。
きっと難しいことではないのだと思うのですが、
いろいろ調べても見つけられませんでした。。。
どなたか教えていただけませんか？
やりたい事は、
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も一致するものは、０個か１個なので、
条件に一致するものを見つけて貼り付けが終わったら終了させたいです。
拙い説明ですみません。
宜しくお願いします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
