excel中vba开发工具

发布于:2025-06-26 ⋅ 阅读:(16) ⋅ 点赞:(0)

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

支持模多次模糊查询

Private Sub CommandButton1_Click()
Call vehicle_查询
End Sub

Private Sub Worksheet_Activate()
    Call vehicle_取出车架号和公司名称 '取出不重复的车架号
'    Sheet13.ComboBox1.Visible = False '车架号显示
'    Sheet13.ComboBox2.Visible = False '公司名字显示
End Sub

Private Sub ComboBox2_Change() '进行combox的筛选
    On Error Resume Next
'     Call vehicle_取出车架号和公司名称
      Dim n, i, j
      Dim arr()
      With Sheet13.ComboBox2
            If .Text <> "" Then
                find_t = .Text
                number_t = .ListCount - 1
                For n = 0 To number_t
                      If InStr(.List(n), .Text) > 0 Then
            '                  Debug.Print .List(n)
                        ReDim Preserve arr(i)
                            arr(i) = .List(n)
                            i = i + 1
                      Else:
                      Call vehicle_取出车架号和公司名称
'                      arr = Sheet13.ComboBox2.List
'            '                         .RemoveItem (n)
'                            Debug.Print .List(n)
                      End If
            
                Next
                
            End If
            .List = arr
      End With
End Sub
Private Sub ComboBox1_Change() '进行combox的筛选
    On Error Resume Next

'     Call vehicle_取出车架号和公司名称
      Dim n, i, j
      Dim arr()
        Sheet13.Range("X3").Value = "=IF(O" & i + 3 & "=" & """" & "前置" & """" & ",F" & i + 3 & ",IF(O" & i + 3 & "=" & """" & "后置" & """" & ",DATE(YEAR(F" & i + 3 & "),MONTH(F" & i + 3 & ")+1,DAY(F" & i + 3 & ")),F" & i + 3 & "))"  '生成公式
       Sheet13.Range("Y3").Value = "=DATEDIF(F" & i + 3 & ",G" & i + 3 & "," & """" & "m" & """" & ")+" & "1"  '生成公式
        Sheet13.Range("z3").Value = "1"
        Sheet13.Range("AA3").Value = "=N3"
      With Sheet13.ComboBox1
            If .Text <> "" Then
                find_t = .Text
                number_t = .ListCount - 1
                For n = 0 To number_t
                      If InStr(.List(n), .Text) > 0 Then
            '                  Debug.Print .List(n)
                        ReDim Preserve arr(i)
                            arr(i) = .List(n)
                            i = i + 1
                      Else:
'                      Call vehicle_取出车架号和公司名称
'            '                         .RemoveItem (n)
'                            Debug.Print .List(n)
                      End If
            
                Next
            End If
            .List = arr
      End With
     
      
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call vehicle_取出车架号和公司名称  '取出不重复的车架号
       If Target.Column = 10 And Target.Row = 3 Then
        With 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 With
        ElseIf Target.Column = 5 And Target.Row = 3 Then
                With Sheet13.ComboBox2
                    .Visible = True
                 .Width = Target.Width + 3
                 .Height = Target.Height + 3
                 .Left = Target.Left + 1
                 .Top = Target.Top + 25
                 .Activate
                  .AutoSize = False
                  .Text = ""
                  .DropDown
                
            End With
        Else
            Sheet13.ComboBox1.Visible = False '车架号显示
            Sheet13.ComboBox2.Visible = False '车架号显示
       End If
End Sub
Private Sub ComboBox1_Click() '车架号
'       Selection.Value = Sheet13.ComboBox1.Text
    Sheet13.Range("j3") = Mid(Sheet13.ComboBox1.Text, InStr(1, Sheet13.ComboBox1.Text, ".") + 1, Len(Sheet13.ComboBox1.Text))
    Sheet13.ComboBox1.Visible = False '车架号显示
     Call vehicle_查询
End Sub
Private Sub ComboBox2_Click() '公司吗
'       Selection.Value = Sheet13.ComboBox1.Text
    MsgBox "测试" & Sheet13.ComboBox2.Text
      Sheet13.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 = False
   Sheet13.Range("E3") = ""
   
   Sheet13.ComboBox2.Activate
   Sheet13.ComboBox2.DropDown
   Sheet13.Range("E3").Select
   
   Sheet13.Range("E3") = Sheet13.ComboBox2.Text
 End If
 
End Sub

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

Private Sub ComboBox2_Change() '进行combox的筛选
    On Error Resume Next
      Dim n, i, j
      Dim arr()
      With Sheet13.ComboBox2
            If .Text <> "" Then
                find_t = .Text
                number_t = .ListCount - 1
                For n = 0 To number_t
                      If InStr(.List(n), .Text) > 0 Then
            '                  Debug.Print .List(n)
                        ReDim Preserve arr(i)
                            arr(i) = .List(n)
                            i = i + 1
                      Else:
'            '                         .RemoveItem (n)
'                            Debug.Print .List(n)
                      End If
            
                Next
            End If
            .List = arr
      End With
End Sub

4、


网站公告

今日签到

点亮在社区的每一天
去签到