[已解决]求助完善代码，条件判断的代码~

jkl86262123

效果见附件，谢谢~

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2015-7-22 16:42

jkl86262123 发表于 2015-7-22 16:12
谢谢，能不能就是那个  例如C列合计的单元格，合计完之后，代码自动执行  E列跳出  合计  二字，我想  把 ...

那就改成这样吧。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. On Error Resume Next
   
3. Dim Rng As Range, R As Range, Tmp$
   
4. Set Rng = Intersect(Target, Columns(2))
   
5. If Not Rng Is Nothing Then
   
6.     Application.EnableEvents = False
   
7.     With CreateObject("vbscript.regexp")
   
8.         .Global = True
   
9.         .Pattern = "[\u4e00-\u9fa5]"
   
10.         For Each R In Rng
    
11.             If Len(R.Text) Then
    
12.                 temp = .Replace(R.Text, "")
    
13.                 If IsError(Evaluate(temp)) = False Then R.Offset(, 1).Value = Evaluate(temp)
    
14.             Else
    
15.                 R.Offset(, 1).Value = ""
    
16.             End If
    
17.         Next R
    
18.     End With
    
19.     Application.EnableEvents = True
    
20. End If
    
21. Set Rng = Nothing
    
22. Set R = Nothing
    
23. If Target.Column = 3 Then
    
24. Application.EnableEvents = False
    
25.     Set Rng = Columns("C:C").SpecialCells(xlCellTypeFormulas, 23)
    
26.     Rng.Offset(, 2) = "合计"
    
27.     If Intersect(Rng, Target) Is Nothing And Target.Offset(, 2) = "合计" Then Target.Offset(, 2) = ""
    
28. Application.EnableEvents = True
    
29. End If
    
30. End Sub
    

复制代码

跳转到最佳答案楼层

gufengaoyue

在你原来的代码里面（放最前或最后都行）加上下面这句。

1. Columns("C:C").SpecialCells(xlCellTypeFormulas, 23).Offset(, 2) = "合计"

复制代码

jkl86262123

gufengaoyue 发表于 2015-7-22 15:52
在你原来的代码里面（放最前或最后都行）加上下面这句。

这段代码放在原先代码的哪里呢？

gufengaoyue

Set R = Nothing  后面就好

jkl86262123

gufengaoyue 发表于 2015-7-22 15:52
在你原来的代码里面（放最前或最后都行）加上下面这句。

我放在开头和结尾都试过了，会提示未找到单元格

jkl86262123

gufengaoyue 发表于 2015-7-22 15:55
Set R = Nothing  后面就好

我放在开头和结尾都试过了，会提示未找到单元格  错误1004

gufengaoyue

附件.rar (34.19 KB, 下载次数: 6)

2015-7-22 16:07 上传

点击文件名下载附件

jkl86262123

gufengaoyue 发表于 2015-7-22 16:07

谢谢，能不能就是那个  例如C列合计的单元格，合计完之后，代码自动执行  E列跳出  合计  二字，我想  把C列合计单元格清除内容，代码也自动执行， 合计二字  自动消失掉  对那些 非合计单元格没影响      


还有1个问题就是  如果C列的都是空的时候，执行代码会跳出错误 找不到单元格 错误1004

gufengaoyue

jkl86262123 发表于 2015-7-22 16:12
谢谢，能不能就是那个  例如C列合计的单元格，合计完之后，代码自动执行  E列跳出  合计  二字，我想  把 ...

那就改成这样吧。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. On Error Resume Next
   
3. Dim Rng As Range, R As Range, Tmp$
   
4. Set Rng = Intersect(Target, Columns(2))
   
5. If Not Rng Is Nothing Then
   
6.     Application.EnableEvents = False
   
7.     With CreateObject("vbscript.regexp")
   
8.         .Global = True
   
9.         .Pattern = "[\u4e00-\u9fa5]"
   
10.         For Each R In Rng
    
11.             If Len(R.Text) Then
    
12.                 temp = .Replace(R.Text, "")
    
13.                 If IsError(Evaluate(temp)) = False Then R.Offset(, 1).Value = Evaluate(temp)
    
14.             Else
    
15.                 R.Offset(, 1).Value = ""
    
16.             End If
    
17.         Next R
    
18.     End With
    
19.     Application.EnableEvents = True
    
20. End If
    
21. Set Rng = Nothing
    
22. Set R = Nothing
    
23. If Target.Column = 3 Then
    
24. Application.EnableEvents = False
    
25.     Set Rng = Columns("C:C").SpecialCells(xlCellTypeFormulas, 23)
    
26.     Rng.Offset(, 2) = "合计"
    
27.     If Intersect(Rng, Target) Is Nothing And Target.Offset(, 2) = "合计" Then Target.Offset(, 2) = ""
    
28. Application.EnableEvents = True
    
29. End If
    
30. End Sub
    

复制代码

jkl86262123

谢谢回答，完全符合我的要求，十分完美的公式！