当前位置：首页 > news >正文

excel中vba开发工具

news 来源：原创 2025/6/26 7:51:07

1、支持单元格点击出现弹框进行选择

Private Sub Worksheet_Activate()Call vehicle_取出车架号和公司名称 '取出不重复的车架号
'    Sheet13.ComboBox1.Visible = False '车架号显示
'    Sheet13.ComboBox2.Visible = False '公司名字显示
End SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)Call vehicle_取出车架号和公司名称  '取出不重复的车架号If Target.Column = 10 And Target.Row = 3 ThenWith Sheet13.ComboBox1.Visible = True.Width = Target.Width + 3.Height = Target.Height + 3.Left = Target.Left + 1.Top = Target.Top + 25'                       .Clear.Activate.AutoSize = False.Text = "".DropDown'                      .AddItem "重庆渝运通冷链物流有限公司"End WithElseIf Target.Column = 5 And Target.Row = 3 ThenWith Sheet13.ComboBox2.Visible = True.Width = Target.Width + 3.Height = Target.Height + 3.Left = Target.Left + 1.Top = Target.Top + 25.Activate.AutoSize = False.Text = "".DropDownEnd WithElseSheet13.ComboBox1.Visible = False '车架号显示Sheet13.ComboBox2.Visible = False '车架号显示End If
End SubPrivate Sub ComboBox1_Click() '车架号
'       Selection.Value = Sheet13.ComboBox1.TextSheet13.Range("j3") = Mid(Sheet13.ComboBox1.Text, InStr(1, Sheet13.ComboBox1.Text, ".") + 1, Len(Sheet13.ComboBox1.Text))Sheet13.ComboBox1.Visible = False '车架号显示
End Sub
Private Sub ComboBox2_Click() '公司吗
'       Selection.Value = Sheet13.ComboBox1.TextSheet13.Range("E3") = Mid(Sheet13.ComboBox2.Text, InStr(1, Sheet13.ComboBox2.Text, ".") + 1, Len(Sheet13.ComboBox2.Text))Sheet13.ComboBox2.Visible = False '车架号显示
End Sub

2、单元格双击事件，双击谈成下拉框

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) '双击事件If Target.Column = 5 And Target.Row = 3 Then
'    Sheet13.ComboBox2.Visible = FalseSheet13.Range("E3") = ""Sheet13.ComboBox2.ActivateSheet13.ComboBox2.DropDownSheet13.Range("E3").SelectSheet13.Range("E3") = Sheet13.ComboBox2.TextEnd IfEnd Sub

3、支持下拉和模糊查询comobox

Private Sub ComboBox2_Change() '进行combox的筛选On Error Resume NextDim n, i, jDim arr()With Sheet13.ComboBox2If .Text <> "" Thenfind_t = .Textnumber_t = .ListCount - 1For n = 0 To number_tIf InStr(.List(n), .Text) > 0 Then'                  Debug.Print .List(n)ReDim Preserve arr(i)arr(i) = .List(n)i = i + 1Else:
'            '                         .RemoveItem (n)
'                            Debug.Print .List(n)End IfNextEnd If.List = arrEnd With
End Sub