複数の項目のドロップダウン - 出力の書式設定

Question

誰かが下のVBAコードで私を助けてくれますか？同じセルの異なる行に結果を表示する代わりに、同じ列の異なる行に表示したいと考えています。

あなたのお手伝いをさせていただきます。

Private Sub Worksheet_Change(ByVal Target As Range) 
**' To Select Multiple Items from a Drop Down List in Excel and display the 
' result in different rows for further calculations.** 
Dim Oldvalue As String 
Dim Newvalue As String 
Application.EnableEvents = True 
On Error GoTo Exitsub 
    If Target.Column = 8 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 & Chr(10) & Newvalue*** 
     Else: 
     Target.Value = Oldvalue 
     End If 
    End If 
    End If 
End If 
Application.EnableEvents = True 
Exitsub: 
Application.EnableEvents = True 
End Sub 

Answer 1

このサブは、サブ値をトリガーした範囲より下のセルを古い値に渡します。同じ値域の下に新しい値2のセルを渡します。あなたは、人々があなたのコードを見てみたい場合は

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim Oldvalue As String '<~ declare old value 
Dim Newvalue As String '<~ declare new value 

Application.EnableEvents = True '<~enable events(idunno why) 

    On Error GoTo ExitSub '<~ simple error handler 
    If Not Target.Column = 8 Then GoTo ExitSub '<~ if the change not happened in col8 then exit 
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then GoTo ExitSub 
    If Target.Value = "" Then GoTo ExitSub  '<~ if the new value is blank then exit 

    Application.EnableEvents = False   '<~ disableevents 
    Newvalue = Target.Value      '<~ pass new value into a variable 
    Application.Undo       '<~ force undo 
    Oldvalue = Target.Value      '<~ pass previous value into a variable 
    Target.Value = Newvalue      '<~ give new value 
     If Not Oldvalue = "" Then     '<~ check if old value is blank 
     If InStr(1, Oldvalue, Newvalue) = 0 Then '<~ check if the old value 
      Target.Offset(1, 0).Value = "Old Value: " & Oldvalue '<~ pass old value to a cell below the 
      Target.Offset(2, 0).Value = "New Value: " & Newvalue '<~ range that made a change 
     End If 
     End If 

ExitSub: 
Application.EnableEvents = True 
End Sub