一实例讲解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