アプリ版：「スタンプのみでお礼する」機能のリリースについて

マジレス希望

エクセル VBA For Next 繰り返しの書き方を教えてください

解決済

見よう見まねで「全商品画像」フォルダにある画像をJAN入力すると画像がエクセルシートに表示されるものを作成しています。下記は問題なく実行できるのですが、画像が１つのみの表示となります。
エクセルの表はC3,D3,E3,F3,G3,H3,I3, C8,D8,E8,F8,G8,H8,I8 それぞれにJANを入力すると
　　　　　　　M4,O4,P4,Q4,R4,S4,T4　M9,O9,P9,Q9,R9,S9,T9 のセルにそれぞれの画像が入るようにしたいです。
私の技術では下記式を複数回コピペしてそれぞれのセル位置を書き換えることしかできません。
For　Next を使ってやれればといろいろ調べましたが、さっぱりわかりませんでした。
どなたかアドバイスをお願いします。よろしくお願いします。

Private Sub Worksheet_Change(ByVal Target As Range)
Const trgR As String = "C3" 'JANを入力するセル
Const insR As String = "M4" '挿入画像の左上のセル


Const Path As String = "C:\Users\画像管理\全商品画像\" 'ファイルの格納フォルダ
Const pic As String = ".jpg" '「.(半角)」＋ファイルの拡張子"
Dim shp As Shape
Dim buf As String
If Target.Address(0, 0) = trgR Then
For Each shp In ActiveSheet.Shapes '既に表示されている画像を削除する処理
If Not Intersect(Range(insR), Range(shp.TopLeftCell, _
shp.BottomRightCell)) Is Nothing Then
shp.Delete
End If
Next
Range(insR).Select
buf = Dir(Path & Target.Value & pic)
If buf <> "" Then '入力したファイル名があるかチェック
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)

.Height = 93
.Left = .Left + (Selection.Width - .Width) / 2


End With

Else

End If
End If
Target.Offset(1, 0).Select

質問者からの補足コメント

  • へこむわー

    お世話になっています。
    教えていただいたもので書き直したのですが、↓回答いただいた中のこの部分がどのようにすればいいのかがわかりません。
    ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
    まとめ
    Const trgR As String = "C3" 'JANを入力するセル

    これらに関係するコードを見直す
    ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
    上記以外書き直したものでC3にJANを入れると画像が指定場所に出てきます。D3にJANを入れると当然反応しないのですが、「Const trgR As String = "C3" 」←これをどう書けばD3やE3も反応するようになるのでしょうか？
    お忙しいと存じますが、ご教示いただければ幸いです。
    ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

    No.4の回答に寄せられた補足コメントです。 補足日時：2022/09/02 13:00
    通報する
通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (6件)

No.6ベストアンサー

  • 回答者： Qchan1962
  • 回答日時：

＃５訂正


なんとなく
'Selectしていないので不要？
'Target.Offset(1, 0).Select　と書いてしまいましたが

そのままの
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)・・・
なので　セルを選択しないとダメですね
忘れていました、どうしましょう・・

①か②で対応してください

①
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)
の上にinpicCell.Selectを加えるか・・
inpicCell.Selectを加えた場合、
'Target.Offset(1, 0).Select　も　実行するようにしてください

②
.Left = .Left + (inpicCell.Width - .Width) / 2
を
.Left = inpicCell.Left + (inpicCell.Width - .Width) / 2
とする

貼り付けた画像の.Leftは初めは貼り付けたセルの.Leftと同じ
なので inpicCell.Leftとすればターゲットセルの位置になりますね
    • good
    • 0
    • 件
通報する
この回答へのお礼

できましたーーー！
このたびは大変お手数をおかけし、また親切に教えていただき、本当にありがとうございました。厚く厚く御礼申し上げます。

通報する
お礼日時：2022/09/02 14:30

No.5

  • 回答者： Qchan1962
  • 回答日時：

やっぱり、説明が下手ですみません・・


コードに説明と添削を加えました。
イベントプロシージャ内ではありますが　＃４の回答と照らしながら
ブレークポイントなどを設置してステップ実行などで各値、メソッドを確認してみてください
画像のサイズなどは、記載コードのまま、画像リンクされますが・・むしろ良いのかも

Private Sub Worksheet_Change(ByVal Target As Range)
'TargetとOffsetで行うため下記不要
'Dim trgR As String, insR As String
'Const trgR As String = "C3" 'JANを入力するセル
'Const insR As String = "M4" '挿入画像の左上のセル
If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
'OFFSET(lgR ,intC)引き数設定
Dim lgR As Long, intC As Integer
'C列の場合は10列右、それ以外は11列右
If Target.Column = 3 Then intC = 10 Else intC = 11
'入力セルの1行下
lgR = 1
'画像フォルダ・拡張子取得設定
Const Path As String = "C:\Users\画像管理\全商品画像\" 'ファイルの格納フォルダ
Const pic As String = ".jpg" '「.(半角)」＋ファイルの拡張子"
Dim shp As Shape
Dim buf As String
Dim inpicCell As Range
'画像挿入セルRange(insR)を入力セルの相対位置Target.Offset(lgR, intC)で変数にセット
Set inpicCell = Target.Offset(lgR, intC)

'Intersect(Target, Range("C3:I3, C8:I8"))で行っているので検証不要
'If Target.Address(0, 0) = trgR Then

For Each shp In ActiveSheet.Shapes '既に表示されている画像を削除する処理
If Not Intersect(inpicCell, Range(shp.TopLeftCell, _
shp.BottomRightCell)) Is Nothing Then
shp.Delete
End If
Next

buf = Dir(Path & Target.Value & pic)
If buf <> "" Then '入力したファイル名があるかチェック
'Range(insR)を入力セルの相対位置 Target.Offset(lgR, intC) 変数inpicCellで代用
With ActiveSheet.Pictures.Insert(Path & Target.Value & pic)
.Height = 93
.Left = .Left + (inpicCell.Width - .Width) / 2
End With
Else
End If
End If
'Selectしていないので不要？
'Target.Offset(1, 0).Select

End Sub

不要（書き換え）旧コードはコメントにして残していますので参考にしてください　また、環境を作ってテストしていませんので、検証はコピーブックなどで行って下さい
変数は変更したりしていますが、メソッドなどはすでに使われていますので説明は割愛しますが、自身で内容（ロジック・意味）を確認してください。
上手くいかないかも知れませんのでダメな時は知らせてください

ボタンで行う場合の改造は　＃４を再度確認してトライしてみてください
    • good
    • 0
    • 件
通報する
この回答へのお礼

ありがとうございます！素晴らしいです、C3,E3と入力していくと画像貼付動作します。
ただ2点だけございました。。
・画像はJAN右１０列に行かず、真下に行ってしまいます。
Dim lgR As Long, intC As Integer
'C列の場合は10列右、それ以外は11列右
If Target.Column = 3 Then intC = 10 Else intC = 11
'入力セルの1行下
lgR = 1
・既に表示されている画像の削除がうまくいきませでした。。

自分なりに考えたのですが、情けないことにわかりません。。

通報する
お礼日時：2022/09/02 14:07

No.4

  • 回答者： Qchan1962
  • 回答日時：

＃３です


②の方法で良いのかな？

すでに書きましたが、
実行範囲制御、定数の見直しなどで対応できると思います
（すでに使われている関数、メソッドのみです）

実行範囲を考えましょう
現状実行分岐は　If Target.Address(0, 0) = trgR Then　ですね
trgRの値が実行ごとに変われば良いのですが・・これはConst　定数ですね
変数にすれば書き換えられますが・・なんか矛盾があるような・・
例えば　Targetが変更されたセルなので　trgR=Target.Address(0, 0)
で変数に代入・・のちに分岐？　すべてTrueになりますね
C3セルの場合　そもそも　Target = Range(trgR)ですからね

そこで、コード内にもあります
If Not Intersect(xxx,yyy) Is Nothing Then　を使います
コードの意味は既に使われているので割愛します
例を示すと　C3,D3,E3,F3,G3,H3,I3, C8,D8,E8,F8,G8,H8,I8 の入力で実行なので
If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
実行したいコードはこの中に入ります
End If
これで対象入力セルのチェンジで実行出来そうです

次に考える必要があるのは出力セル　これも変わりますので・・
どうしましょう。これもすでに使われている　Target.Offset(1, 0).Select
Offsetを使います。同様に割愛

入力と出力の関係を確認しましょう。。規則性がありますね良かった

C列に入力時10列右のセル　行は入力セルの1つ下
C列以外は11列右・・・
これもケースによって値が違うので変数に入れるのが簡単

後はそのままでも良さそう・・かな

まとめ
Const trgR As String = "C3" 'JANを入力するセル
Const insR As String = "M4" '挿入画像の左上のセル
これらに関係するコードを見直す
If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
で分岐　if　内はTarget　が　Range(trgR)　と同じ

Offsetを使い画像出力セルを特定する
C3を入力した時の対象セルは Target.Offset(1, 10)
これは　Range(insR)　と同じ

これが出来れば　ボタンなどからまとめて実行　For Next　は超簡単です

If Not Intersect(Target, Range("C3:I3, C8:I8")) Is Nothing Then
処理
End If　

を

標準モジュールに
For Each Target In Range("C3:I3, C8:I8")
処理
Next
で流用出来ると思います（シートオブジェクトを加える）などはしてください

文才はなく説明べたなのでコードを書いた方が簡単ですけれど
取り合えず説明にチェレンジしてみました。。分らない所は追記してください
この回答への補足あり
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございます。
明日トライしてみます！わからないところが出てきたら、またご連絡します。感謝します。

通報する
お礼日時：2022/09/01 18:12

No.3

  • 回答者： Qchan1962
  • 回答日時：

こんにちは


示されているコードとなさりたい事を読むと　For Next　ではないような気がします
現在、C3セルに入力するとM4セルに画像が挿入されるで間違えありませんか
そうすると、まだD3などには、まだJANが入っていないのではないでしょうか
望まれている処理手順はどちらでしょうか

①すべてのJANを入力した後にボタンなどでまとめて処理をする場合
For Nextなど繰り返し処理

②入力の度に画像を挿入する場合は
現在のPrivate Sub Worksheet_Change(ByVal Target As Range)内の
実行範囲制御、定数の見直しなどで対応できると思います
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございます。
記載したVBAはセルC3にJANを入れるとセルM4に画像が出てきます。ただ、１つの設定なので、となりのセル（D3）にJANを入れたらN4に画像がでるようにしたいのです。他のセルも同様にJANに入力するたびに画像が出てくるようにしたいのです。

通報する
お礼日時：2022/09/01 17:09

No.2

  • 回答者： 銀鱗
  • 回答日時：

・・・For～Next・・・


繰り返し処理は、カウンターを回してそのカウンターの値がいくつになったら繰り返し処理を終われ、という構文になります。
そして、このカウンターの値を利用するのが一般的。

For i=1 to 10
　Print 100+i
Next i
こんな感じで10個の連続した数字を表示するとかね。

……たぶん、これは理解されていると思います。
（基本中の基本ですからね）

で、次。
・・・セルの指定の仕方・・・

M4セルを指定する場合、
　Range("M4")
のようにセル番地を文字列で指定する方法と、
　Cell(4,13）
のように行と列を指定する方法があります。

……お気づきですね。

ということで、「Range」ではなく「Cell」を使えば楽に指定できることが分かると思います。
まあ、M列が13列目とか数える必要があって面倒かもしれないけど、
それさえクリアしてしまえばプログラム（Visual Basic for Application の頭文字をとってVBAです）を簡単に作ることができます。
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございます。Cellsに変更してやってはいたのですが、エラーが起こってしまいます。

通報する
お礼日時：2022/09/01 17:12

No.1

カウンター変数でセル座標を変えるだけです。

セル座標をコンスタントにするのは使いづらくなるだけなので止めたほうが良い。

繰り返し処理（For Next)｜VBA入門
https://excel-ubara.com/excelvba1/EXCELVBA316.html
    • good
    • 0
    • 件
通報する
この回答へのお礼

回答ありがとうございます。添付いただいたURLのような基礎的なことはわかるのですが、やりたいことができないのです。

通報する
お礼日時：2022/09/01 17:14

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

ページトップページトップ

Q質問する（無料）

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

おすすめ情報