値変更することにより、プルダウンリストの数が変更される

Question

実現したいこと

プルダウン(数値)が変更されることで、別セルにプルダウンリストを作成するプログラムを作成いたしました。
値の変更時のイベントプロシージャで変更前の値を取得し、変更後も変更前の値を削除することなく、プルダウンを作成することができましたが、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

Answer 1

似たような事例で無理やり感ありますが
SendKeys "{RIGHT}"
使ってます…

Comments

[taroooo]

ご回答ありがとうございます。
SendKeysを使用すればできるでしょうか？

VBAのキーコード転送を使って操作するとのことですが、具体的にどのようにすればいいのでしょうか？
ご教授いただければ幸いです。

[ramosu11]

間違っていたらすみません。
　①セル選択で保存
　②セル変更で別セルにプルダウン作成
　③続けてセル値変更
　　　※①が行われないのがこまる…
という認識でよろしいでしょうか？
上記であればセルの値が変更されたらいったん別のセルに飛ぶというプログラム(以下例)を追加したらよいかと思いました。
　SendKeys "{RIGHT}"　で隣のセルに移動
　Range(〇).Select　〇は対象のセル以外のアドレス

[taroooo]

回答ありがとうございます。
①A1セル選択→値の読み取り(このとき、Selectionで値を読み取ります)
②A1セルのプルダウン値を変更(例:1→5)
③D列に赤枠が1つ→5増える
というものです。上記のやり方だと、

①の場合別セルを選択してから、A1を選択すると値を取得することになります。
②で連続的にプルダウンで値を変更し続けると、今のコードでは機能しなくなります。。。

なので、②を連続的に変更しようとしても、できなくするようにするコードで対応できればいいのかな？
と思っております。。。
例えば、②でA1セルを連続的に変更しようとすると、メッセージボックスが開き、別のセルを選択してから、
A1プロダウンで値を変更してくださいとか。。。

その場合、①のSelectionでコード変更すれば、いけるのかどうか、模索中です。

セルの移動は値のみ移動させることできるのでしょうか？

[ramosu11]

"②を連続的に変更しようとしても、できなくする"
のみでしたら"②"のプログラムの最後に別セルに飛ぶプログラム(06/07 15:00)を入れていただくのが一つかと思っております。
あとは以下もありかと思っております。
　SelectionでA1セル保護解除
　Changeの最後にA1セル保護

"②で連続的にプルダウンで値を変更し続けると、今のコードでは機能しなくなります。。。"
→こちらを機能するようにというのも本来ご希望でしょうか？

[taroooo]

②を連続的に変更しようとしても、できなくする"
のみでしたら"②"のプログラムの最後に別セルに飛ぶプログラム(06/07 15:00)を入れていただくのが一つかと思っております。
>>別セルに飛ばすプログラム入れれば、解決しました。
長々とおありがとうございます。

[ramosu11]

解決できたようで良かったです。
挙げておきながらなんですが、SendKeyはお勧めしません…
　Range(〇).Select
で対応いただくと良いかと思います。
今のセル基準に決まった数移動の形であれば以下になるかと思います。
ActiveCell.Offset(動かしたい行数, 動かしたい列数).Select

Answer 2

Worksheet_Changeだけでおこなうようにしました。
Worksheet_SelectionChangeはコメントアウトしてください。
最初に前のドロップダウンリストを全て削除するようにしました。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim VALafter As Variant
    Dim dropDownValues() As String    ' ドロップダウンリストの中身を定義

    Dim i As Long
    Dim k As Variant
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    If Target.Cells.count <> 1 Then Exit Sub
    If IsNumeric(Target.Value) = False Then Exit Sub
    dropDownValues = Split("30,35,40,45,50,60,65,70,75,80,85,90,95,100")    ' ドロップダウンリストを設定する
    VALafter = Int(Target.Value)
    Application.EnableEvents = False
    '以前のリストを削除
    With Range("D3:D" & Rows.count)
        .Validation.Delete
        .ClearContents
        .Borders.LineStyle = xlLineStyleNone
    End With
    For i = 1 To VALafter
        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
    Application.EnableEvents = True
End Sub

Comments

[taroooo]

tatsu99様
回答ありがとうございます。

Worksheet Changeのみでは私もできましたが、組んでいただいたプログラムだと前回の情報が全て消えてしまいます。(例えばB1セルの数字を３とするとD列に3つのプルダウンリストが生成されます。D5のプルダウンリストを触って数字をいれている状態で、B1セルのプルダウンを変更されると、D５の情報が全て消えてしまいます)
この以前の情報をそのまま残しておいた状態にしたかったので、Selectionを使用いたしました。

次SelectionにするとB1セルを選び、プルダウンで数字変更し、またB1セルのプルダウンを数字変更しても数字変更通り、D列にプルダウンリストが生成されるような仕組みにしたいです。

そのようなことはできるでしょうか？

[tatsu99]

最後のほうで、
VAL = VALafter
Application.EnableEvents = True
End Sub
のようにVALにVALafterを設定しておけば、良いかと思います。
VALは、宣言セクションで定義してある前提です。
その場合、1回目は、VALになにも値が入ってないので、その判断が必要になります。
If IsEmpty(VAL) = True Then
'最初の１回目の処理
End If
のようにすれば、１回目の判断ができます。

[tatsu99]

数値として扱うと、何も設定されていない場合は、０として扱われます。
それで、良いなら、１回目の判定は不要です。

[tatsu99]

すみません。上記の方法だと、最初に表示したときに、B1の値がVALに反映されないですね。
前の２つのコメントは無視してください。

[tatsu99]

B1には直接、値を入力する前提ですが、
B1を選択し、B1の内容を変更しても、そのあとでENTERキーを押下するか、マウスでB1以外のセルを選択しないと
Changeイベントは発生しないですね。
従って、B1の値を変えただけでは無理かと思われます。
お役に立てなくて申し訳ありません。

[tatsu99]

すみません。前の情報を残すというのは、D列に入力された情報を残すという意味ですね。
前のドロップダウンリスト数を残すと勘違いしていました。
下記のように、.ClearContentsの行を削除するか、コメントアウトすれば、D列の値は残ります。

'以前のリストを削除
With Range("D3:D" & Rows.count)
.Validation.Delete
'.ClearContents
.Borders.LineStyle = xlLineStyleNone
End With

但し、B1を選択し、B1の内容を変更しても、そのあとでENTERキーを押下するか、マウスでB1以外のセルを選択しないとChangeイベントは発生しないので、本来のあなたの要望は解決されませんのでご了承ください。

[taroooo]

ご丁寧にありがとうございます。
やはり、B1セル以外のセルを触ってから出ないと、難しいですよね。

他のやり方でできないか模索してみます。

ありがとうございました。