首页 > 单独文章 > 正文

一实例讲解EXCEL中VBA程序

时间:2009-06-08 21:12:07 作者:officeba 【认证】
品名 数量 单价 "不含税
金额" 税额 金额合计 要求: 1.单价是含税单价,即数量*单价=金额合计
AAA 19.00 2.50 40.60 6.90 47.50 2.税额=金额合计/1.17*0.17并且四舍五入保留2位
DDD 20.00 3.50 59.83 10.17 70.00 3.不含税金额=金额合计-税额
CCC 60.00 4.80 246.15 41.85 288.00 4.用事件完成,不能用函数或者调用函数
5.输入时A列第3行输入完 回车后自动激活到B列第3
行,B列输入完回车,激活C列第3行,输入完C列第3
行,回车后,完成后边的计算并且激活A列下一行
以此类推
6.A列输入简码回车后自动出品名,简码未找到,弹
出提示
7.删除品名,则同行A-F列数据都删除

看代码段一:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 1 Then
        If Target <> "" Then
       Dim rng As Range
            Set rng = Range("I14:J23").Find(what:=Target.Value, lookat:=xlWhole)
            If Not rng Is Nothing Then
                Application.EnableEvents = False
                Target = Range("J" & rng.Row)
                Application.EnableEvents = True
                Target.Offset(0, 1).Select
            Else
                MsgBox "未找到"
        Target.ClearContents
            End If
        End If
    End If
If Target.Column = 2 And Target.Row > 1 Then
        If Target <> "" Then
            Target.Offset(0, 1).Select
        End If
    End If
    If Target.Column = 3 And Target.Row > 1 Then
        If Target <> "" Then
            Target.Offset(0, 3) = Range("B" & Target.Row) * Range("C" & Target.Row)
            Target.Offset(0, 2) = Target.Offset(0, 3) / 1.17 * 0.17
            Target.Offset(0, 1) = Target.Offset(0, 3) - Target.Offset(0, 2)
            Target.Offset(1, -2).Select
        End If
    End If
End Sub
代码段二:
Private Sub Worksheet_Change(ByVal Target As Range)
'如果是A列,并且只选择了一个单元格
If Target.Column = 1 And Target.Cells.Count = 1 Then
   Target.Offset(0, 1).Resize(1, 2).ClearContents
'如果是B列,并且只选择了一个单元格
ElseIf Target.Column = 2 And Target.Cells.Count = 1 Then
   Target.Offset(0, 1).ClearContents
End If

End Sub
代码段三:
下面代码没有成功:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row > 1 Then
        If Target <> "" Then
       Dim rng As Range
       Dim x
            x = Target.Row

            Set rng = Range("I14:J23").Find(what:=Target.Value, lookat:=xlWhole)
            If Not rng Is Nothing Then
                Application.EnableEvents = False
                Target.Value = Range("J" & rng.Row).Value
                Application.EnableEvents = True
                Target.Offset(0, 1).Select
            Else
                MsgBox "未找到"
                Target.ClearContents
            End If
        End If
    Else
        If Cells(x, 2) <> "" And Cells(x, 3) <> "" Then
            Cells(x, 6).Formula = "=B" & x & "*C" & x
        End If
    End If
End Sub
以上问题如何解决呢?
解决办法:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iRan As Range, tRan As Range, fRan As Range
Application.EnableEvents = False
Application.ScreenUpdating = False

Set iRan = Intersect(Target, Range("A:A"), Range("2:" & Cells.Rows.Count))
If Not iRan Is Nothing Then
     For Each tRan In iRan
         If tRan.value = "" Then
             tRan.Range("B1:F1").ClearContents
         Else
             Set fRan = Range("I14:I23").Find(what:=tRan.value, lookat:=xlWhole)
             If Not fRan Is Nothing Then
                 tRan.value = fRan.Offset(0, 1).value
                 tRan.Offset(0, 1).Select
             Else
                 Set fRan = Range("J14:J23").Find(what:=tRan.value, lookat:=xlWhole)
                 If fRan Is Nothing Then
                     MsgBox "未找到"
                     tRan.Range("A1:F1").ClearContents
                 Else
                     tRan.Offset(0, 1).Select
                 End If
             End If
         End If
     Next
  End If

Set iRan = Intersect(Target, Range("B:B"), Range("2:" & Cells.Rows.Count))
If Not iRan Is Nothing Then
     For Each tRan In iRan
         If tRan.value <> "" Then
             tRan.Offset(0, 1).Select
         End If
     Next
End If

Set iRan = Intersect(Target, Range("C:C"), Range("2:" & Cells.Rows.Count))
If Not iRan Is Nothing Then
     For Each tRan In iRan
         If tRan.value <> "" Then
             tRan.Offset(0, 3).value = tRan.value * tRan.Offset(0, -1).value
             tRan.Offset(0, 2).value = Round(tRan.Offset(0, 3).value / 1.17 * 0.17, 2)
             tRan.Offset(0, 1) = tRan.Offset(0, 3) - tRan.Offset(0, 2)
             tRan.Offset(1, -2).Select
         End If
     Next
End If
  
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


相关文章

同类最新