複数の項目をExcelのデータ検証フィールドに選択する

Question

シートに複数のドロップダウンリストがあり、検証されたフィールド内に複数の選択肢を入力する必要が生じることがあります。つまり、リンゴ以上のものが必要な場合もあるし、オレンジも必要な場合もある。データ検証フィールドはリンゴ/オレンジになります。

このコードは最近まで使用されていましたが、何らかの理由で機能しませんでした。このコードはモジュール内ではなく、そのシート内で動作するために「シート」内にあります。

シート上のスペックは以下のとおりです。マクロはロックされています（ロックされていない状態で放置しようとしましたが、修正できませんでした）。同じブックに同じようなコードを持つ2枚のシートがあります（私は他のシートからスクリプトを削除しようとしましたが、修正しませんでした）。そこにはもう1つの質問がありますが、これにはかなり近いですが答えはありませんので、このコードがうまくいけば "知っている"ことを願っていますが、今誰かが私にチェックアウトすることはできません。

Private Sub Worksheet_Change(ByVal Target As Range) 
'Code by Sumit Bansal from https://trumpexcel.com 
' To Select Multiple Items from a Drop Down List in Excel 
Dim Oldvalue As String 
Dim Newvalue As String 
Application.EnableEvents = True 
On Error GoTo Exitsub 
If Target.Column = 2 And Target.Row > 11 And Target.Row < 27 Then 
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then 
     GoTo Exitsub 
    Else: If Target.Value = "" Then GoTo Exitsub Else 
     Application.EnableEvents = False 
     Newvalue = Target.Value 
     Application.Undo 
     Oldvalue = Target.Value 
     If Oldvalue = "" Then 
      Target.Value = Newvalue 
     Else 
      If InStr(1, Oldvalue, Newvalue) = 0 Then 
       Target.Value = Oldvalue & "/" & Newvalue 
      Else: 
       Target.Value = Oldvalue 
      End If 
     End If 
    End If 
End If 

Answer 1

あなたの問題は、無効にしてイベントを有効にすることにあると思います。
私はあなたのコードをリファクタリングし、正常に動作します。下記を参照してください：

Private Sub Worksheet_Change(ByVal Target As Range) 
'Original Code by Sumit Bansal from https://trumpexcel.com 
'To Select Multiple Items from a Drop Down List in Excel 

'Refactored error handling... 
    On Error GoTo halt 
    Dim Oldvalue As String, Newvalue As String 
    Application.EnableEvents = False '/* disable events here */ 
    If Target.Column = 2 And Target.Row >= 11 And Target.Row <= 27 Then 
     If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then 
      'GoTo ExitSub 
     Else 
      If Target.Value = "" Then GoTo ExitSub 
      Newvalue = Target.Value: Application.Undo 
      Oldvalue = Target.Value 
      If Oldvalue = "" Then 
       Target.Value = Newvalue 
      Else 
       If InStr(1, Oldvalue, Newvalue) = 0 Then 
        Target.Value = Oldvalue & "/" & Newvalue 
       Else 
        Target.Value = Oldvalue 
       End If 
      End If 
     End If 
    End If 

ExitSub: 
    Application.EnableEvents = True '/* enable before exit */ 
    Exit Sub 
halt: 
    '/* handle error and communicate to user */ 
    MsgBox "Opps, encountered error but dismissed it. See details below:" & _ 
    vbNewLine & Err.Number & ": " & Err.Description 
    Err.Clear '/* clear the error */ 
    Resume ExitSub '/* make sure to re-enable events */ 
End Sub 

私も関連性のないコードを削除しました。 HTH。