首页 > 解决方案 > Excel VBA - 将下拉选择中的值粘贴到列中

问题描述

For i = 1 To 20
If Target.Address = "$B$15" 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
Worksheets("DropDowns").Cells(i + 7, 26).Value = Newvalue
Next i

我在代码的以下部分遇到问题:

Worksheets("DropDowns").Cells(i + 7, 26).Value = Newvalue

它上面的代码使列表下拉菜单具有多个选择,我试图将选择粘贴到一个单元格中,然后将新选择粘贴到它下面的单元格中,直到不再进行选择为止。但是,它目前正在做的是粘贴选择,然后将第二个选择粘贴到第一个上,然后将第三个粘贴到第二个等等。 下拉菜单选择正在粘贴的内容,我想要粘贴的内容

标签: excelvba

解决方案


这应该做你想要的:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue, Newvalue, arr, rngList As Range
    
    If Target.Address <> "$B$15" Then Exit Sub
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    
    Set rngList = Worksheets("DropDowns").Cells(8, 26)
    
    If Len(Target.Value) = 0 Then
        rngList.Resize(20, 1).ClearContents
        Exit Sub
    End If
        
    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
    Application.EnableEvents = True
    
    'update the list of values
    With rngList
        .Resize(20, 1).ClearContents
        arr = Split(Replace(Target.Value, " ", ""), ",") 'remove spaces before splitting
        .Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr)
    End With
      
End Sub

仅供参考,最好不要:将多个语句放在一行上 - 它会很快变得混乱,尤其是在If块内。


推荐阅读