精华内容
下载资源
问答
  • 由于B列部门列经常需要重复录入,而且部门列表一般为固定的序列(如图2-58中E列所示),如何用VBA对B列创建下拉列表以便输入内容? 员工编号 部门 姓名 部门列表 0006 财务部 程建华 ...

    目录

    示例:

    实现代码:

    Validation对象

    Validation对象的Add方法


    示例:

        如图所示,该表为某公司员工的档案录入表。由于B列部门列经常需要重复录入,而且部门列表一般为固定的序列(如图2-58中E列所示),如何用VBA对B列创建下拉列表以便输入内容?

    员工编号部门姓名 部门列表
    0006财务部程建华 财务部
    0009财务部李国敏 人事部
    0016财务部袁志刚 管理部
    0125人事部杨建军 市场部
    0209人事部曲波 销售部
    0017管理部周汉林 总经办
    0018管理部骈永富  
    0020管理部孙玉梅  
    0023管理部陈亚菁  
    0072管理部刘志峰  
    0080管理部刘玉录  

     

    实现代码:

    Option Explicit
    
    Sub 创建下拉列表()
        With Range("B2:B" & Rows.Count).Validation
            '删除已有数据有效性
            .Delete
            '创建数据有效性,设置为序列,数据源为E列,"Formula1"最后一个字符是数字1
            .Add Type:=xlValidateList, Formula1:="=" & Range("E2", Cells(Rows.Count, "E").End(xlUp)).Address
        End With
    End Sub

    Validation对象

        Validation是单元格的一个重要属性,它可以返回一个Validation对象。该对象用以控制单元格“数据有效性”。作为一个对象,Validation有其自有的方法和属性。在使用Validation之前,必须以Add方法创建一个数据有效性,然后才能对其属性进行赋值,否则
    将会出现运行时错误。与Add方法相对的是Delete方法,其功能是清除数据有效性设置。

    Validation对象的Add方法

    Validation对象的Add方法用于创建一个数据有效性,其语法为

    VLD.Add (Type,[AlertStyle],[Operator],[Formulal],[Formula2])

        其中,VLD代表一个Validation对象。参数Type为数据有效性的类型,可以为表中的任意常量。

                                    表   Validation Add方法的Type参数

        常  量

     

        说  明

    xlValidateCustom

    7

    使用任意公式验证数据有效性

    xlValidateDate

    4

    日期值

    xlValidateDecimal

    2

    数值

    xlValidateInputOnly

    0

    仅在用户更改值时进行验证

    xlValidateList

    3

    值必须存在于指定列表中

    xlValidateTextLength

    6

    文本长度

    xlValidateTime

    5

    时间值

    xlValidateWholeNumber

    1

    全部数值

    xlValidateDate

    4

    日期值

    • 参数AlertStyle为警告样式,即发生错误时出现的警告,可以为xIValidAlertlnformation(出现信息)、xIValidAlertStop(停止录入)或xIValidAlertWarnin(出现警告).
    • 参数Operator表不Formula1和Formula2的验证运算符,可以为表中的任意常量。

          表   Validation Add方法的Operator参数

        常  量

       

        说  明

    xlBetween

    1

    介于。只在提供了两个公式的情况下才能使用

    xlNotBenveen

    2

    不介于。只在提供了两个公式的情况下才能使用

    lEqual

    3

    等于

    xlNotEqual

    4

    不等于

    xlGreater

    5

    大于

    xlLess

    6

    小于

    xlGreatetEqual

    7

    大于或等于

    xlLessEqual

    8

    小于或等于

    注意
        在使用Add方法创建数据有效性之前,若单元格已经存在数据有效性设置,则必须先删除数据有效性之后才能创建,否则将出现如图所示的错误。因而,本例在创建数据有效性之前,首先使用了Delete方法以避免发生错误。

     

     

    展开全文
  • VBA实现Excel单元格下拉框复选demo,需要结合VB代码实现,demo很详细
  • 使用VBA实现Excel下拉多选

    万次阅读 2019-02-13 17:42:37
    Excel的下拉多选 新项目需要excel导入时的下拉多选框 Excel表格下拉单选很简单,先给表格做成单选。参照 Excel要想做成多选首先需要启用宏,如果Excel中没有宏,需要下载 下载安装 安装完之后重启Excel。 点击宏,...

    Excel的下拉多选

    新项目需要excel导入时的下拉多选框

    Excel表格下拉单选很简单,先给表格做成单选。参照
    [excel怎么设置下拉选择项] (https://jingyan.baidu.com/article/1876c85255d929890a13767d.html)
    Excel要想做成多选首先需要启用宏,如果Excel中没有宏,需要下载

    下载安装

    安装完之后重启Excel。

    在当前sheet上点击开发工具,再点击VB编辑器
    左侧project是你的Excel表格,表格下对应每一个sheet。双击你想要修改的sheet即可打开下图VB编辑器。粘贴下方代码。

    点击宏,创建新宏如下图操作。
    (宏名随意输入)

    粘代码

    Sub Worksheet_Change(ByVal Target As Range)
    '让数据有效性选择 可以多选,不可重复
    Dim rngDV As Range
    Dim oldVal As String
    
    Dim newVal As String
    If Target.Count > 1 Then GoTo exitHandler
    
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    
    If rngDV Is Nothing Then GoTo exitHandler
    
    If Intersect(Target, rngDV) Is Nothing Then
    'do nothing
    
    Else
    Application.EnableEvents = False
    newVal = Target.Value
    If Target.Column = 2 Or 3 Or 6 Then '数字是你想要多选的列是多少,多个用or连接。
    Application.Undo
    oldVal = Target.Value
    Target.Value = newVal
    If oldVal = "" Then
    Else
    If newVal = "" Then
    Else '去除重复的字段
           If InStr(1, oldVal, newVal) <> 0 Then
              If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then '最后一个选项重复
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
              Else
                Target.Value = Replace(oldVal, newVal & ",", "") '不是最后一个选项重复的时候处理逗号
              End If
            Else '不是重复选项就视同增加选项
    Target.Value = oldVal _
    & "," & newVal '可以是任意符号隔开
    End If
    End If
    End If
    End If
    End If
    exitHandler:
    Application.EnableEvents = True
    End Sub
    提示:在“ ' ”后面的是注释可以删除
    保存一下点击运行-->运行子过程/用户窗体,点击你创建的宏后,点击右侧运行。
    

    结果如下图
    在这里插入图片描述

    展开全文
  • 在很多的报表开发中,需要用到VBA去设置Excel的一些规则。 以下是一个根据下拉框单元格的值来给特定单元格进行赋值的代码: Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume ...

    在很多的报表开发中,需要用到VBA去设置Excel的一些规则。 

    以下是一个根据下拉框单元格的值来给特定单元格进行赋值的代码:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        On Error Resume Next:
        Application.ScreenUpdating = False
        If Target.Column = 7 Then        // 这是需要赋值的DDL列
            If Target.Offset(0, -2).Value = 13 Then  //表示赋值列往前移动两个单位的格子值
                With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                 xlBetween, Formula1:="No"   //赋值为No
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
                .ShowInput = True
                .ShowError = True
                End With
            ElseIf Target.Offset(0, -2).Value <> 13 Then
                With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                 xlBetween, Formula1:="=Exp"  //这里的Exp为自定义名字的列作为数据来源(Formulas -〉Name managers ) 
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .IMEMode = xlIMEModeNoControl
               .ShowInput = True
                .ShowError = True
                End With
            End If
        ElseIf Target.Column = 8 Then   //下面的逻辑用来控制,当第7列值为No时,会把第8,910,11列保护起来不能输入
            If Target.Offset(0, -1).Value = "No" Then
                Target.Locked = True
                Target.Offset(1, -6).Select
            End If
        ElseIf Target.Column = 9 Then
            If Target.Offset(0, -2).Value = "No" Then
                Target.Locked = True
                Target.Offset(1, -7).Select
            End If
        ElseIf Target.Column = 10 Then
            If Target.Offset(0, -3).Value = "No" Then
                Target.Locked = True
                Target.Offset(1, -8).Select
            End If
        ElseIf Target.Column = 11 Then
            If Target.Offset(0, -4).Value = "No" Then
                Target.Locked = True
                Target.Offset(1, -9).Select
            End If
        End If
        Application.ScreenUpdating = True
         
    End Sub

     

    转载于:https://www.cnblogs.com/Aaron-Lee/p/9962690.html

    展开全文
  • VBA实现动态查询下拉列表输入

    千次阅读 2020-07-25 23:43:53
    Excel利用VBA实现下拉列表,同时支持输入时动态查询,根据输入的不同实现动态的查询 先看一下实验效果: 当点击website这一列时会出现所有的网站列表,双击可点击选择数值填入 输入关键字时会只出现包含关键字的...

    博主公众号:Romi的杂货铺,欢迎关注一起玩耍!

    Excel利用VBA实现下拉列表,同时支持输入时动态查询,根据输入的不同实现动态的查询

    先看一下实验效果:

    当点击website这一列时会出现所有的网站列表,双击可点击选择数值填入
    在这里插入图片描述

    输入关键字时会只出现包含关键字的结果

    在这里插入图片描述

    在C,D两列选择单元格后会出现仅在此网站下的数据如果网站为空则会自动向上寻找,同时也支持自定义的搜索
    在这里插入图片描述

    在这里插入图片描述

    接下来为主要的实现方法:

    第一部分为工作表选取改变事件,实现的是当有单元格被选定时会自动出现下拉菜单和输入框。首先需要在sheet中创建一个listbox和textbox.在开发工具-插入-下拉框/文本框注意要选activex控件,不能选择上面的控件

    具体代码及注释如下:

    '工作表选取改变事件
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim i, x, rownu As Variant
        Dim d As Object
        Dim arr, arr_key, arr1, yun, arr_po
        Dim website_name As String
        
        Set d = CreateObject("scripting.dictionary")
        Me.ListBox1.Clear
        'target为选取的单元格对象
        tacolumn = Target.Column
        tarow = Target.Row
      
        '添加website部分
        '选择触发的区域,使用Target.Cells.CountLarge是为了保证选择的是一个单元格而不是一片区域,同时区域过大不会报错
            If Target.Column = 1 And Target.Row > 10 And Target.Cells.CountLarge = 1 Then
                With Me.TextBox1'textbox的大小,位置,和显示
                    .Visible = True
                    .Top = Target.Top
                    .Left = Target.Left
                    .Width = Target.Width
                    .Height = Target.Height
                    .Activate
                End With
                With Me.ListBox1'listbox的大小,位置,和显示
                    .Visible = True
                    .Top = Target.Top
                    .Left = Target.Left + Target.Width
                    .Width = 400
                    .Height = 300
                    '将需要写入的数据装入数组
                    arr = Sheets("format_information").Range("a2:a" & Sheets("format_information").Cells(Rows.Count, 1).End(xlUp).Row)
                    For x = 1 To UBound(arr)
                    d(arr(x, 1)) = ""
                    Next
                    '将值写入到listbox中
                    .List = d.keys()
                    
                End With
        
         'position和fomat部分.逻辑与上述代码一致
            ElseIf (Target.Column = 3 Or Target.Column = 4) And Target.Row > 10 And Target.Cells.CountLarge = 1 Then
                website_name = Cells(Target.Row, 1).Value
                rownu = Target.Row - 1
                Do Until website_name <> ""
                    website_name = Cells(rownu, 1).Value
                    rownu = rownu - 1
                Loop
                
                With Me.TextBox1
                    .Visible = True
                    .Top = Target.Top
                    .Left = Target.Left
                    .Width = Target.Width
                    .Height = Target.Height
                    .Activate
                End With
                With Me.ListBox1
                    .Visible = True
                    .Top = Target.Top
                    .Left = Target.Left + Target.Width
                    .Width = 400
                    .Height = 300
                    yun = SQLtoArr("Select position_channel,Format FROM [format_information$] where Website like '%" & website_name & "%'")
                    arr_po = Sheets("format_information").Range("AA1:AA" & Sheets("format_information").Cells(Rows.Count, 27).End(xlUp).Row)
                    arr1 = Sheets("format_information").Range("AB1:AB" & Sheets("format_information").Cells(Rows.Count, 28).End(xlUp).Row)
                    For x = 1 To UBound(arr_po)
                    d(arr_po(x, 1) & "■" & arr1(x, 1)) = ""
                    Next
                    .List = d.keys()
                
                End With
                          
            
            
            Else
                Me.ListBox1.Clear
                Me.TextBox1 = ""
                Me.ListBox1.Visible = False
                Me.TextBox1.Visible = False
            End If
        
    End Sub
    
    '利用SQL函数进行筛选和取值的函数
    
    Function SQLtoArr(strSQL)
    
     Dim Conn As Object, Rst As Object
     Dim strConn As String
     Dim i As Integer, PathStr As String
     Set Conn = CreateObject("ADODB.Connection")
     Set Rst = CreateObject("ADODB.Recordset")
     PathStr = ThisWorkbook.FullName '设置工作簿的完整路径和名称
     Select Case Application.Version * 1 '设置连接字符串,根据版本创建连接
     Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
     Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
     End Select
     
    Conn.Open strConn '打开数据库链接
    Set Rst = Conn.Execute(strSQL) '执行查询,并将结果输出到记录集对象
    Sheets("format_information").Columns("AA:AB").Clear
    Sheets("format_information").Range("AA2").CopyFromRecordset Rst '#####################在这里改输出的位置与单元格
    Rst.Close  '关闭数据库连接
    Conn.Close
    'Set Conn = Nothing
    'Set Rst = Nothing
    
    
    End Function
    

    第二部分为键入字符后执行搜索的功能

    'textbox键盘抬起事件:即输入了文字
    Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        Dim i, x As Integer
        Dim Language As Boolean, arr1 As Variant
        Dim myStr As String, str_B As String
        Dim d As Object
        Dim arr, arr_key
        
        Set d = CreateObject("scripting.dictionary")
        Me.ListBox1.Clear
        myStr = Me.TextBox1.Value
        With Me.ListBox1
                    .Width = 400
                    .Height = 300
        End With
        If tacolumn = 1 And tarow > 10 Then
        With Sheets("format_information")
               
                    arr1 = .Range("a2:a" & .Range("a65535").End(xlUp).Row)
                    For i = 1 To .Range("a65535").End(xlUp).Row - 1
                    '利用instr遍历找到包含输入文字的部分,并 赋值到字典里避免重复
                       If InStr(1, arr1(i, 1), myStr, 1) Then
                           d(arr1(i, 1)) = ""
                       End If
                    Next i
                    Me.ListBox1.List = d.keys()'listbox赋值
                
        End With
        ElseIf (tacolumn = 3 Or tacolumn = 4) And tarow > 10 Then
        With Sheets("format_information")
               
                    arr = .Range("c2:c" & .Range("c65535").End(xlUp).Row)
                    arr1 = .Range("d2:d" & .Range("d65535").End(xlUp).Row)
                    For i = 1 To .Range("c65535").End(xlUp).Row - 1
                       If InStr(1, arr(i, 1), myStr, 1) Or InStr(1, arr1(i, 1), myStr, 1) Then
                           d(arr(i, 1) & "■" & arr1(i, 1)) = ""
                       End If
                    Next i
                    
                    Me.ListBox1.List = d.keys()
                    
        End With
        End If
    End Sub
    

    第三部分为双击选取值的部分

    'listbox双击事件
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim arr
        
        If (tacolumn = 1 Or tacolumn = 2) And tarow > 10 Then
        '将listbox值赋予当前单元格
            ActiveCell.Value = Me.ListBox1.Value
            Me.ListBox1.Clear
            Me.TextBox1 = ""'清空listbox与textbox
            Me.ListBox1.Visible = False'y隐藏textbox和listbox
            Me.TextBox1.Visible = False
         ElseIf (tacolumn = 3 Or tacolumn = 4) And tarow > 10 Then
            arr = Split(Me.ListBox1.Value, "■")
            ActiveCell.Value = arr(0)
            ActiveCell.Offset(0, 1).Value = arr(1)
            Me.ListBox1.Clear
            Me.TextBox1 = ""
            Me.ListBox1.Visible = False
            Me.TextBox1.Visible = False
        End If
    End Sub
    

    具体文件和代码可于https://github.com/smilecoc/VBA_listinput_tools下载查看

    个人公众号:Smilecoc的杂货铺,欢迎关注!
    在这里插入图片描述

    展开全文
  • listview 中双击该单元格显示下拉列表
  • 一、问题描述利用Excel制作下拉菜单,当某一列有空白单元格时,如下图所示 在下拉菜单中,也会存在空白单元格 常规制作下拉菜单的方法没有办法避免该问题,所以需要利用VBA解决这个问题二、解决方法解决该问题的VBA...
  • 现希望建立一个查询表,在查询表中建立二级下拉列表,可供选择部门以及部门内的员工。该如何用VBA实现? 员工编号 姓名 部门 基本工资 0006 程建华 管理部 2875 0009 李国敏 管理部 ...
  • excel下拉菜单vba 在Excel下拉菜单中删除使用过的项目 (Remove Used Items in Excel Drop Down) There is a new sample file on my Contextures web site, which lets you pick players for each inning in a ...
  • VBA 中COMBOBOX下拉列表的收起

    千次阅读 2015-04-30 16:07:48
    在使用VBA的COMBOBOX组件的时候,想制作一个点击单元格即自己弹出下拉列表,点击其它单元格更改COMBOBOX的位置,同样的弹出下拉列表的功能,遇到了这样的一个问题: COMBOBOX提供了DROPDOWN的方法,但是却没有提供...
  • 单元格下拉框实现复选框多选 将复选框链接到带有宏的单元格 (Link Check Boxes to Cells With a Macro) You can use check boxes on a worksheet, and link the results to a cell. If the box is checked, the cell...
  • 3、[允许]下拉列表中选择[序列] 4、[来源]输入[增,删,改,查](逗号是英文的,内容任意),勾选“提供下拉箭头”,确定即可。 5、点选区内任一单元个,即可用下拉箭头填写其中任一符号。 就不做图文的了 简单~
  • 我们知道,在Excel中我们可以给数据添加下拉选择框 即在数据验证当中选择序列,然后输入选择框的选择范围即可 但是这并不能够实现多选的功能 只能选择若干选择中的一项 我们可以在VBA中使用宏来添加多选框 代码如下...
  • Private Sub Worksheet_... '用SendKeys语句发送快捷键【ALT+方向键向下】,调取单元格下拉列表  If Target.Address = "$H$2" Then Application.SendKeys "%{down}"  End Sub  ...
  • DTPicker1控件的下拉按钮请问怎么写代码可以使得DTPicker控件的下拉日期表显示出来呢?!Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _(ByVal hWnd As Long, _ByVal wMsg As Long, _...
  • excel下拉菜单vba 一站式提供不同的Excel下拉菜单 (Different Excel Drop Downs from One Source)To help users enter data in a spreadsheet, you can create drop down lists with Excel's Data Validation ...
  • 表格操作系列 九、使用表中的某列设置单元格有效性(下拉列表) 在给表格制作下拉列表时,需要用数据有效性的方法将表中的某一个数据填到某一个格中,这样可以在使用表格时,很方便的输入数据,并且可以避免手工录入...
  • 需求用数据有效性来定义下拉菜单,并当选项变更时触发事件。经学习发现,在每个表格的独立VBA代码内可以配置事件触发管理。如图: 代码如下:Private Sub Worksheet_Change(ByVal Target As range) '当单元格D20被...
  • 该资源是一个名为Test的excel 文件,下载后打开,如果你的excel是2007版则会在加载项里出现Custmization 下拉框,如果是2003版,则直接在菜单栏里多出一个Customization下拉框,...注:vba代码可以按alt+F11组合键查看
  • 2.按Alt+F11,进入VBA编程界面。双击“ThisWorkbook”(就是本EXCEL对象),输入代码: Private Sub Workbook_Open() Sheet1.ComboBox1.Visible = False End Sub 这个语句的作用是,启动EXCEL文件时,...
  • 目录 题 码 TextBox控件和ListBox控件 ListBox控件的ListFiIIRange属性和List...如图所示,该表为某公司客户一览,现准备建立查询表,希望在查询表的客户列中建立下拉列表,并允许输入关键字后显示匹配该关键字..
  • Excel 下拉列表数据有效性智能匹配筛选 来源公式如下(适用于2010以上版本) =OFFSET(数据!$A$1,MATCH(INDIRECT("R"&ROW()&"C"&COLUMN(),)&"*",数据!$A:$A,0)-1,,COUNTIF(数据!$A:$A,INDIRECT("R...
  • vba在excel中创建下拉框

    千次阅读 2011-08-19 10:42:32
    在Sheet2中把C1:C7的区域命名为code,在sheet1中给“A1”cell加下拉框,下拉框的内容用的是区域code的内容 Sub Macro1()  Dim s As String  s = setName(3, "code")  Sheet1
  • Excel下拉列表多选框实现

    千次阅读 2011-12-15 19:57:02
    Excel提供了下拉列表的实现,但并不支持多选,后来慢慢找资料终于利用VBA编程实现了多选的问题。 首先点击视图-&gt;宏,工程资源所示: 有Microsoft Excel对象:对应的是Sheet1或Sheet2对像等; 窗体:对应的是...
  • 多个外键实现下拉列表代码 带代码的多选下拉列表 (Multiple Selection Drop Down With Codes) There is a sample file on my website that has VBA code for selecting multiple items from a data validation drop ...
  • 让EXCEL单元格具有下拉列表功能(ComboBox)解决方法 让EXCEL单元格具有下拉列表功能(ComboBox)今日在做一个让EXCEL和ComboBox类似这类控件组合的文件。挺方便实用的。 1.新建一个EXCEL文件,点“视图”-》“工具...
  • excel下拉菜单vba 在Excel下拉菜单中显示警告 (Show Warning in Excel Drop Down) With Excel's data validation, you can show a drop down list of items in a cell. You can even create "dependent" drop downs....

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 926
精华内容 370
关键字:

vba单元格下拉列表