数据验证下拉列表

时间:2018-02-12 15:26:49

标签: vba excel-vba validation excel

我对VBA并不擅长。感谢Google,为我的项目提供了很多帮助。我通过"数据和数据验证添加了数据验证,然后列出"但在进行复制粘贴时,我缺少数据验证下拉列表。所以我想通过VBA更新下拉列表,这样即使你复制粘贴,我也不会丢失下拉列表。我想在我的" Data"中添加数据验证。来自" Info"片。在信息表中,我必须定义一些范围。我从谷歌获得了一些代码,它只能在一列中正常工作,但我怎么能给定义范围而不是A1:A5。就像那样,我想在" Data"的每一列中添加somany数据验证。来自" Info"片。

    Private Sub main()
    'replace "A" with the cell you want to insert the dropdown list
    With Sheet2.Range("A2:A10").Validation
   .Delete
   'replace "=A1:A5" with the range the data is in.
   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
   Operator:=xlBetween, Formula1:="=Sheet1!$A$1:$A$5"
   .IgnoreBlank = True
  .InCellDropdown = True
  .InputTitle = ""
  .ErrorTitle = ""
  .InputMessage = ""
  .ErrorMessage = ""
  .ShowInput = True
  .ShowError = True
  End With
  End Sub

2 个答案:

答案 0 :(得分:2)

Operator:=xlBetween, Formula1:="=Sheet1!$A$1:$A$5"

此公式需要参考在验证列表中提供所需值的范围。您希望它是命名范围,而不是像这样的硬编码范围地址。

因此,如果您有数据表,例如tblData,并且该表有一列,例如Values,那么您可以定义工作簿范围的名称它指向tblData[Values]:将该范围命名为AvailableValues,然后您可以执行Formula1:="AvailableValues",您的验证下拉菜单将自动跟上tblData[Values]包含的内容。

除此之外,我不知道你在问什么。希望它有所帮助!

答案 1 :(得分:0)

Option Explicit

'' Validation list with scrollable dropdown.
'' * General Sub without hardcoded specific ranges (modular).
'' * No empty cells at the end of each dropdown.
'' * Calculated Source LastRow and validation dropdown combobox LastRow.
'' * Wrapet with NoUpdate YesUpdate subs for fast run.
'' * Wrapet with Unprotect and re-protect subs for Worksheet that is initially protected.
'' See at the end an example of Call of main sub by RunGeneralValidate

Public Sub GeneralValidate( _
ByVal sheetSource As Worksheet, ByVal columnSource As String, ByVal firstRowSource As Long, _
ByVal sheetCombo As Worksheet, ByVal columnCombo As String, ByVal firstRowCombo As Long)

Dim rangeSource As Range
Dim rangeCombo As Range
Dim lastRowSource As Long
Dim lastRowCombo As Long

Call NoUpdate
Call UnprotectAll

   lastRowSource = sheetSource.Cells(sheetSource.Rows.Count, columnSource).End(xlUp).Row
   lastRowCombo = sheetCombo.Cells(sheetCombo.Rows.Count, columnCombo).End(xlUp).Row
   
    Set rangeCombo = sheetCombo.Range(columnCombo & firstRowCombo & ":" & columnCombo & lastRowCombo)
    Set rangeSource = sheetSource.Range("$" & columnSource & "$" & firstRowSource & ":$" & columnSource & "$" & lastRowSource)
    
    With rangeCombo.Validation
        .Delete ''delete previous validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:="=" & "'" & sheetSource.Name & "'" & "!" & rangeSource.Address
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = vbNullString
        .ErrorTitle = vbNullString
        .InputMessage = vbNullString
        .ErrorMessage = vbNullString
        .ShowInput = True
        .ShowError = True
    End With
    
Call ProtectAll
Call YesUpdate
     
End Sub


Public Sub NoUpdate()
    Application.Cursor = xlWait
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
End Sub


Public Sub YesUpdate()
    Application.Cursor = xlDefault
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub


Public Sub ProtectAll()
' Protect all to dis-allow modifications if locked
'' UserInterfaceOnly Alows VBA code to modify locked cells.

    Dim ws As Worksheet
    ProtectStructure
    For Each ws In ThisWorkbook.Sheets
        If ws.ProtectContents = False Then
                ws.EnableSelection = xlNoRestrictions
                    ws.Protect Password:="1234", _
                               Contents:=True, AllowInsertingColumns:=False, AllowInsertingRows:=False, _
                               AllowDeletingColumns:=False, AllowDeletingRows:=False, UserInterfaceOnly:=True, _
                               AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _
                               AllowFiltering:=False, AllowSorting:=False, AllowInsertingHyperlinks:=True, _
                               DrawingObjects:=False, Scenarios:=True, AllowUsingPivotTables:=False
                               
                                If ActiveSheet.Protection.AllowFormattingColumns = False Then
                                   ActiveSheet.Protect AllowFormattingColumns:=True
                                End If
         End If
    Next
End Sub

'Unprotectall to unlock cells and allow modifications
Public Sub UnprotectAll()
On Error Resume Next
    Dim ws As Worksheet
    UnProtectStructure
    For Each ws In ThisWorkbook.Sheets
   If ws.ProtectContents = True Then
        ws.Unprotect "1234"
        ws.Cells.Locked = False
    End If
    Next ws
End Sub

Public Sub RunGeneralValidate()
''Example of running the subs
Dim Info As Worksheet
Dim Data As Worksheet
Call GeneralValidate(Info, "A", 2, _
                     Data, "D", 4)
                     
Call GeneralValidate(Info, "B", 2, _
                     Data, "E", 4)

Call GeneralValidate(Info, "C", 2, _
                     Data, "F", 4)
End Sub
相关问题