[已解决]求同步清空对应单元格内容的VBA代码

jinzikun

拜托各位大师，我想利用VBA同步清空对应单元格内容，不知代码怎么写才简洁高效，请不吝赐教！谢谢！！！

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-5-18 17:24

加入Application.EnableEvents =是为了防止连锁反应，顺便把你代码的语法错误一并修改了，不清楚你的处理需求，所以逻辑不作检查，原封不动实现。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim rng As Range, i&, j&
   
3. Application.EnableEvents = False
   
4. For i = 3 To 21 Step 2
   
5.   If rng Is Nothing Then Set rng = Cells(4, i).Resize(45) Else Set rng = Union(rng, Cells(4, i).Resize(45))
   
6. Next i
   
7. If Not Application.Intersect(Target, rng) Is Nothing Then a = Target.Column: b = Target.Row: colu = (a - 1) / 2 + 26: Cells(b, colu) = Now
   
8. For i = 4 To 48
   
9.   For j = 3 To 21 Step 2
   
10.     If Cells(i, j) = "" Then Cells(i, (j - 3) / 2 + 27) = ""
    
11.   Next j
    
12. Next i
    
13. Application.EnableEvents = True
    
14. End Sub

复制代码

跳转到最佳答案楼层

fjmxwrs

修改一下你的单元格事件即可，加个判断、

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim a%, b%, colu%, str1
   
3.     a = Target.Column: b = Target.Row: colu = (a - 1) / 2 + 7
   
4.     str1 = Target.Value
   
5.     If a < 8 And a > 1 And b > 3 And a Mod 2 = 1 Then
   
6.         If str1 = "" Then
   
7.             Cells(b, colu) = ""
   
8.         Else
   
9.             Cells(b, colu) = Now
   
10.         End If
    
11.     End If
    
12. End Sub

复制代码

zhangmengyuan66

学习了，楼上回复的很简洁，明了

jinzikun

fjmxwrs 发表于 2017-5-12 11:31
修改一下你的单元格事件即可，加个判断、

谢谢大师的指点，一个一个单元格删可以，一个以上单元格一起删“If str1 = "" ”Then句出错。

jinzikun

jinzikun 发表于 2017-5-13 16:04
谢谢大师的指点，一个一个单元格删可以，一个以上单元格一起删“If str1 = "" ”Then句出错 ...

我不懂VBA,请问大师以下代码如何精简：
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("c4:c48,e4:e48,g4:g48,i4:i48,k4:k48,m4:m48,o4:o48,q4:q48,s4:s48,u4:u48")) Is Nothing Then  a = Target.Column: b = Target.Row: colu = (a - 1) / 2 + 26  
    Cells(b, colu) = Now
Dim i As Integer
For i = 4 To 48
If Range("c" & i) = "" Then Range("aa" & i) = ""
If Range("e" & i) = "" Then Range("ab" & i) = ""
If Range("g" & i) = "" Then Range("ac" & i) = ""
If Range("i" & i) = "" Then Range("ad" & i) = ""
If Range("k" & i) = "" Then Range("ae" & i) = ""
If Range("m" & i) = "" Then Range("af" & i) = ""
If Range("o" & i) = "" Then Range("ag" & i) = ""
If Range("q" & i) = "" Then Range("ah" & i) = ""
If Range("s" & i) = "" Then Range("ai" & i) = ""
If Range("u" & i) = "" Then Range("aj" & i) = ""
Next
End If
End Sub

大灰狼1976

加入Application.EnableEvents =是为了防止连锁反应，顺便把你代码的语法错误一并修改了，不清楚你的处理需求，所以逻辑不作检查，原封不动实现。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim rng As Range, i&, j&
   
3. Application.EnableEvents = False
   
4. For i = 3 To 21 Step 2
   
5.   If rng Is Nothing Then Set rng = Cells(4, i).Resize(45) Else Set rng = Union(rng, Cells(4, i).Resize(45))
   
6. Next i
   
7. If Not Application.Intersect(Target, rng) Is Nothing Then a = Target.Column: b = Target.Row: colu = (a - 1) / 2 + 26: Cells(b, colu) = Now
   
8. For i = 4 To 48
   
9.   For j = 3 To 21 Step 2
   
10.     If Cells(i, j) = "" Then Cells(i, (j - 3) / 2 + 27) = ""
    
11.   Next j
    
12. Next i
    
13. Application.EnableEvents = True
    
14. End Sub

复制代码

jinzikun

大灰狼1976 发表于 2017-5-18 17:24
加入Application.EnableEvents =是为了防止连锁反应，顺便把你代码的语法错误一并修改了，不清楚你的处理需 ...

谢谢大师，解决了我在清除数据时无法同步删除所有“日期时间”的问题。我在原有代码中删除了“Dim i As Integer……Next”并添加了以下代码就实现了：

• For b = 4 To 48
• For a = 3 To 21 Step 2
• If Cells(b, a) = "" Then Cells(b, (a - 1) / 2 + 26) = ""
• Next a
• Next b