Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 13419|回复: 6

[已解决]VBA中的change事件问题

[复制链接]
发表于 2011-8-12 13:56 | 显示全部楼层 |阅读模式
Private Sub Worksheet_Change(ByVal Target As Range)
   For r = 3 To 112
     If Target.Column = 8 And Cells(r, 8) = "" Then
     Exit Sub
        Else
           End If
    Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim r As Integer
    For r = 3 To 112
    If Target.Column = 8 And Cells(r, 8) <> 0 Then
   
      Cells(r, 30).Value = Val(Cells(r, 22)) - Val(Cells(r, 24)) _
- Val(Cells(r, 25)) - Val(Cells(r, 26)) _
- Val(Cells(r, 27)) - Val(Cells(r, 28)) _
- Val(Cells(r, 29))
      Cells(r, 22).Value = Cells(r, 14) + Cells(r, 15) _
+ Cells(r, 17) - Val(Cells(r, 16)) _
+ Val(Cells(r, 19)) + Val(Cells(r, 20)) _
+ Val(Cells(r, 21)) + Val(Cells(r, 18))
      Cells(r, 23).Value = Val(Cells(r, 22)) _
- Val(Cells(r, 17)) _
- Val(Cells(r, 26)) - 2000
   
       End If
       Next
End Sub

我的目的是想当表中第八列数据变化的时候,激活change事件与selectchange事件,后面同行的单元格自动计算,代码如上,但是当我运行的时候却起不了效果,不知道原因在哪里,请高手指点
最佳答案
2011-8-12 20:08
本帖最后由 zjdh 于 2011-8-12 20:09 编辑

你第8列的数据与参与计算的各列没有任何关系(无公式),最后计算当然不变化啦!
另外:计算先后你也搞错啦,我原来没在意,应该如下:
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Not Intersect(Range("H3:H114"), Target) Is Nothing Then
  3.         r = Target.Row
  4.         If Target.Count = 1 And Cells(r, 8) <> 0 Then
  5.             Cells(r, 22).Value = Cells(r, 14) + Cells(r, 15) _
  6.                            + Cells(r, 17) - Val(Cells(r, 16)) _
  7.                            + Val(Cells(r, 19)) + Val(Cells(r, 20)) _
  8.                            + Val(Cells(r, 21)) + Val(Cells(r, 18))
  9.             Cells(r, 23).Value = Val(Cells(r, 22)) _
  10.                               - Val(Cells(r, 17)) _
  11.                               - Val(Cells(r, 26)) - 2000
  12.             Cells(r, 30).Value = Val(Cells(r, 22)) - Val(Cells(r, 24)) _
  13.                              - Cells(r, 25) - Cells(r, 26) _
  14.                              - Val(Cells(r, 27)) - Val(Cells(r, 28)) _
  15.                              - Val(Cells(r, 29))
  16.         End If
  17.     End If
  18. End Sub
复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2011-8-12 14:28 | 显示全部楼层
jiangslly 发表于 2011-8-12 13:56
Private Sub Worksheet_Change(ByVal Target As Range)
   For r = 3 To 112
     If Target.Column = 8  ...

只要用单元格的值改变事件就可以了,楼主将你这个程序里标成红的语句去除掉再试试看:
Private Sub Worksheet_Change(ByVal Target As Range)
   For r = 3 To 112
     If Target.Column = 8 And Cells(r, 8) = "" Then
     Exit Sub
        Else
           End If
    Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim r As Integer
    For r = 3 To 112
    If Target.Column = 8 And Cells(r, 8) <> 0 Then
   
      Cells(r, 30).Value = Val(Cells(r, 22)) - Val(Cells(r, 24)) _
- Val(Cells(r, 25)) - Val(Cells(r, 26)) _
- Val(Cells(r, 27)) - Val(Cells(r, 28)) _
- Val(Cells(r, 29))
      Cells(r, 22).Value = Cells(r, 14) + Cells(r, 15) _
+ Cells(r, 17) - Val(Cells(r, 16)) _
+ Val(Cells(r, 19)) + Val(Cells(r, 20)) _
+ Val(Cells(r, 21)) + Val(Cells(r, 18))
      Cells(r, 23).Value = Val(Cells(r, 22)) _
- Val(Cells(r, 17)) _
- Val(Cells(r, 26)) - 2000
   
       End If
       Next
End Sub

回复

使用道具 举报

发表于 2011-8-12 14:30 | 显示全部楼层
把=改成<>:
If Target.Column <> 8 And Cells(r, 8) <> "" Then
回复

使用道具 举报

发表于 2011-8-12 14:36 | 显示全部楼层
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Not Intersect(Range("H3:H112"), Target) Is Nothing Then
  3. r = Target.Row
  4. If Target.Count = 1 And Cells(r, 8) <> 0 Then
  5.             Cells(r, 30).Value = Val(Cells(r, 22)) - Val(Cells(r, 24)) _
  6.                                  - Val(Cells(r, 25)) - Val(Cells(r, 26)) _
  7.                                  - Val(Cells(r, 27)) - Val(Cells(r, 28)) _
  8.                                  - Val(Cells(r, 29))
  9.             Cells(r, 22).Value = Cells(r, 14) + Cells(r, 15) _
  10.                                + Cells(r, 17) - Val(Cells(r, 16)) _
  11.                                + Val(Cells(r, 19)) + Val(Cells(r, 20)) _
  12.                                + Val(Cells(r, 21)) + Val(Cells(r, 18))
  13.             Cells(r, 23).Value = Val(Cells(r, 22)) _
  14.                                  - Val(Cells(r, 17)) _
  15.                                  - Val(Cells(r, 26)) - 2000
  16.         End If
  17.     End If
  18. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2011-8-12 14:50 | 显示全部楼层
回复 zjdh 的帖子

谢谢的代码。我把它复制到VBA中运行却还起不了作用,请看附件,麻烦你了

计算案例.rar

27.12 KB, 下载次数: 32

回复

使用道具 举报

发表于 2011-8-12 20:08 | 显示全部楼层    本楼为最佳答案   
本帖最后由 zjdh 于 2011-8-12 20:09 编辑

你第8列的数据与参与计算的各列没有任何关系(无公式),最后计算当然不变化啦!
另外:计算先后你也搞错啦,我原来没在意,应该如下:
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Not Intersect(Range("H3:H114"), Target) Is Nothing Then
  3.         r = Target.Row
  4.         If Target.Count = 1 And Cells(r, 8) <> 0 Then
  5.             Cells(r, 22).Value = Cells(r, 14) + Cells(r, 15) _
  6.                            + Cells(r, 17) - Val(Cells(r, 16)) _
  7.                            + Val(Cells(r, 19)) + Val(Cells(r, 20)) _
  8.                            + Val(Cells(r, 21)) + Val(Cells(r, 18))
  9.             Cells(r, 23).Value = Val(Cells(r, 22)) _
  10.                               - Val(Cells(r, 17)) _
  11.                               - Val(Cells(r, 26)) - 2000
  12.             Cells(r, 30).Value = Val(Cells(r, 22)) - Val(Cells(r, 24)) _
  13.                              - Cells(r, 25) - Cells(r, 26) _
  14.                              - Val(Cells(r, 27)) - Val(Cells(r, 28)) _
  15.                              - Val(Cells(r, 29))
  16.         End If
  17.     End If
  18. End Sub
复制代码
回复

使用道具 举报

发表于 2013-4-13 23:56 | 显示全部楼层
zjdh 发表于 2011-8-12 14:36

我有一个单元格事件问题:http://www.excelpx.com/thread-298859-1-1.html
请指点!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 20:15 , Processed in 0.725449 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表