ID非公開

2019/1/22 14:37

11回答

タイトル:オプションボタンもどきのマクロについて 本文: C12:C99の範囲にプルダウンで○が入るようになっています。 B12:B99は、別のマクロを起動するとランダムで文字列が入ります。

タイトル:オプションボタンもどきのマクロについて 本文: C12:C99の範囲にプルダウンで○が入るようになっています。 B12:B99は、別のマクロを起動するとランダムで文字列が入ります。 B列の文字列は項目になっていて、その項目に対して該当するかどうかC列に○を入力します。このC列の○をオプションボタンのように1か所しか入力できないようにしたいのですが、自分の力量ではどうにもならず、もどきを作成しました。 もどきの内容は原始的で、○を入力した時のアクティブセルをL列の同じ行にコピペ、C列は入力した場所も含めて全削除、L列からコピペしたらL列も削除、という内容です。 書いてて思いましたが、アクティブセルの場所を取得してC列全クリア→記入でよかったですね。後で直します。 上記の内容でいざ実行したところ、当然ながらどのセルでも変動するたびに実行してしまってエラーが出まくる事態になりました。 試しに条件を付けてみましたが、範囲指定をしても、アクティブセルが○の場合のみの指定をしても失敗。エラーが出るわけではないのですが、今度は削除等何も起こらなくなりました。 条件を入れると何故動かなくなってしまうのか、もし分かる方がいらっしゃれば教えていただけると助かります。 マクロの内容は下記のとおりです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim fCircle As Range 'アクティブセルが○なら動く If ActiveCell.Value Like "○" Then 'セルの値に変更があったときに実行したい処理 Application.CutCopyMode = False Selection.Copy 'アクティブセルのコピー ActiveCell.Offset(0, 9).Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '9列移動、一時置き場のL列に貼り付け ここからC列L列のコピペの処理なので割愛 コピペ処理終わって最初のアクティブセルに戻るところ Set fCircle = ActiveSheet.Range("C12", "C102").Find(What:="○") '○を探す If fCircle Is Nothing Then MsgBox "○がない" Else fCircle.Select '○のところをアクティブセルに End If End Sub C列→L列→C列は無駄では? →記録したマクロをベースに弄くるくらいしか出来ず、こうなりました。お恥ずかしい限りですが、これが私の限界です。 オプションボタンを使用すればいいのでは? →B列に値があるかどうかに合わせて表示・非表示が切り替えられるか分からなかったので使っていません。

Visual Basic | Excel27閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0

>Private Sub Worksheet_Change(ByVal Target As Range) シートのChangeイベントを利用していますので、Target変数が値を入力したセルに該当します。 もし、C列で限定するなら、 Dim宣言の前ぐらいに、以下のコードを入力します。 If Target.Column <> 3 Then Exit Sub ※もし、値を入力したセルの列が3(C)でなければ、マクロを終了。 正直、何をしたいのかが分からないので、その他の助言は控えます。 イベントではなく、ボタンからの実行で一度試してみてはどうですか? イベントを使うと、書き方が悪いといろいろなエラーが発生します。一度ボタンから実行するものがうまくいってから考えてみた方が良いかもね。

ID非公開

質問者

2019/1/24 9:14

大変お恥ずかしいのですが、教えていただいたコードを加えても最初は一切動かなくて、何度も確認していたら、そもそもマクロの暴走を止めるために一時的にChangeイベントを無効にしていました。完全に忘れていました。そりゃ何しても動かないですよね。本当にすみません。

ThanksImg質問者からのお礼コメント

おかげさまで出来ました!列3の行12~102で絞って設定して、思ったように動きました!これからはボタンでしっかり試します…。ありがとうございました!

お礼日時:2019/1/24 9:16