実現したいこと
プルダウン(数値)が変更されることで、別セルにプルダウンリストを作成するプログラムを作成いたしました。
値の変更時のイベントプロシージャで変更前の値を取得し、変更後も変更前の値を削除することなく、プルダウンを作成することができましたが、Worksheet_SelectionChangeからのWorksheet_Changeを使用しているため、別セルから、B1セルを選択し、プルダウンで数値を変更させると、うまく動くのですが、B1セルをそのまま選択した状態でもう一度B1セルの値を変更すると、うまくプログラムが動作できません。(当たり前ですが。。。)
B1セルをそのまま選択した状態でもう一度B1セルの値を変更しても適用されるプログラムを作りたいと思っているのですが、どのようにすればいのでしょうか?ご意見あれば、お願いたします。
前提
「実現したいことを参考にしてください」
■■な機能を実装中に以下のエラーメッセージが発生しました。
特にエラーは出ていませんが、以下のプログラムになにか追記すれば、以下のことができるでしょうか?
「B1セルをそのまま選択した状態でもう一度B1セルの値を変更しても適用されるプログラム」を作成したいと思っております。
試したこと
ここに問題に対して試したことを記載してください。
Option Explicit
'============================
'宣言セクション
Dim VAL As Variant
'============================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ENDUP If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub If Target.Cells.Count <> 1 Then Exit Sub VAL = Target.Value
ENDUP:
End Sub
'============================
Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
Dim VALafter As Variant
Dim dropDownValues() As String ' ドロップダウンリストの中身を定義
Dim i As Long
Dim k As Variant
dropDownValues = Split("30,35,40,45,50,60,65,70,75,80,85,90,95,100") ' ドロップダウンリストを設定する
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub If Target.Cells.Count <> 1 Then Exit Sub VALafter = Target.Value Application.ScreenUpdating = False If VALafter = VAL Then '例3段→3段 For i = 1 To VALafter 'If i <= Target.Value Then k = i * 2 + 1 With Me.Range("D" & k).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Formula1:=Join(dropDownValues, ",") '赤枠にする Range("D" & k).Borders.Color = RGB(255, 0, 0) End With Next i End If If VALafter > VAL Then '例:3段→5段 For i = 1 To VALafter 'If i <= Target.Value Then k = i * 2 + 1 With Me.Range("D" & k).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Formula1:=Join(dropDownValues, ",") '赤枠にする Range("D" & k).Borders.Color = RGB(255, 0, 0) End With Next i End If If VALafter < VAL Then For i = VALafter + 1 To VAL '例:5段→3段 'If i <= Target.Value Then k = i * 2 + 1 Range("D" & k).Validation.Delete 'D3セルからD12セルまでのドロップダウンリストを削除 Range("D" & k).ClearContents '数字も削除 Range("D" & k).Borders.LineStyle = xlLineStyleNone Next i End If Application.ScreenUpdating = True
End Sub
回答2件
あなたの回答
tips
プレビュー
下記のような回答は推奨されていません。
このような回答には修正を依頼しましょう。
また依頼した内容が修正された場合は、修正依頼を取り消すようにしましょう。
2023/06/07 05:40
2023/06/07 06:00
2023/06/08 01:48
2023/06/08 02:29
2023/06/08 03:04
2023/06/08 04:23