excel中vba开发工具

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

支持模多次模糊查询

Private Sub CommandButton1_Click()
Call vehicle_查询
End SubPrivate Sub Worksheet_Activate()Call vehicle_取出车架号和公司名称 '取出不重复的车架号
'    Sheet13.ComboBox1.Visible = False '车架号显示
'    Sheet13.ComboBox2.Visible = False '公司名字显示
End SubPrivate Sub ComboBox2_Change() '进行combox的筛选On Error Resume Next
'     Call vehicle_取出车架号和公司名称Dim n, i, jDim arr(), ar()With Sheet13.ComboBox2ar = Application.Transpose(Application.Transpose(.List))If .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 + 1
'                            Sheet13.ComboBox2.Activate
'                            If Len(.Text) = 0 Then
'                                Call vehicle_取出车架号和公司名称
'                                MsgBox "测试"
'                            End IfElse:.List = ar
'                      Call vehicle_取出车架号和公司名称
'                      arr = Sheet13.ComboBox2.List
'            '                         .RemoveItem (n)
'                            Debug.Print .List(n)End IfNextEnd If.List = arrEnd With
End Sub
Private Sub ComboBox1_Change() '进行combox的筛选On Error Resume Next'     Call vehicle_取出车架号和公司名称Dim n, i, jDim 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") = Format(Sheet13.Range("X3").Value, "yyyy年mm月")
'        Sheet13.Range("Y3").NumberFormat = "YYYY年MM月" '转为数值格式Sheet13.Range("Z3").Value = "=DATEDIF(F" & i + 3 & ",G" & i + 3 & "," & """" & "m" & """" & ")+" & "1"  '生成公式
'       Sheet13.Range("Z3").Value = "=X3"Sheet13.Range("AA3").Value = "1"Sheet13.Range("AB3").Value = "=N3"With Sheet13.ComboBox1If .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:
'                      Call vehicle_取出车架号和公司名称
'            '                         .RemoveItem (n)
'                            Debug.Print .List(n)End IfNextEnd If.List = arrEnd WithEnd 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 Sub
Private 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 '车架号显示Call vehicle_查询
End Sub
Private Sub ComboBox2_Click() '公司吗
'       Selection.Value = Sheet13.ComboBox1.Text
'    MsgBox "测试" & Sheet13.ComboBox2.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

4、excel工作表点击，进行公式生成

Private Sub Worksheet_Activate()
On Error Resume NextDim rng, arrDim last_rowDim iWith Sheets("客户账单明细")'last_row = .Cells(Rows.Count, "AF").End(xlUp).Rowlast_row = .UsedRange.Rows.Countarr = .Range("AF2:AF" & last_row)For Each rng In arrIf rng = "" Or .Range("AF" & i + 2).HasFormula = False Then '判断是否有公式.Range("AF" & i + 2) = "=IFERROR(IF(AC" & i + 2 & ">0,IF(AC" & i + 2 & "=AB" & i + 2 & "," & """" & "已付" & """" & ",IF(AC" & i + 2 & ">AB" & i + 2 & "," & """" & "超付" & """" & "," & """" & "不足" & """" & ")),""""),"""")".Range("AF" & i + 2).Interior.ColorIndex = 43 'RGB(142, 770, 81)End Ifi = i + 1 '记录行数NextDebug.Print last_rowEnd With
'    IFERROR(IF(AC2>0,IF(AC2=AB2,"已付",IF(AC2>AB2,"超付","不足")),""),"")
End Sub