工作表事件程序练习1(已结束)
本帖最后由 无聊的疯子 于 2012-2-20 20:22 编辑这是论坛里的一个实列，拆分后拿来做一个Change事件的练习题
代码要求：
with 是必需要使用的，套用越多越好。。但不可重复套用
如 withRange("A5:F5") 而后又来个 with Range("A5:F5")这样就重复使用了
结果要求说明
第一行不能填充颜色
1.同一行中，D列有日期并且E列没有日期，则A到F填充上红色
2.同一行中，D列有日期并且E列有日期， 则A到F列填充上淡蓝色
3.同一行中，D列的日期大于系统日期3天，则A到F列无颜色填充
就三个效果
提示：
该事件程序为 Worksheet_Change 事件
关于单元格颜色代码，附件中也有说明
要多用事件中的 Target 参数
答题截止日期：2012年2月20日 20:00
凡VBA学习小组的成员均可参与练习
回帖注明小组编号与ID，答案正确者，给予一定的评分奖励
重复回复无重复评分
若发现编号与ID不符者可能会受到差评（不填写编号与ID者不给予任何评分）
本贴已设置《仅作者可见》 直接贴代码即可
所需效果如下图，类似于条件格式，
该图为原实列，只需要达到该效果就行，不用管操作的是 D E 列还是 I J 列
各组参与人数和得分如下
本帖最后由 冠军欧洲2010 于 2012-2-18 22:10 编辑
**** Hidden Message *****
我只是看得眼花缭乱，只有羡慕的份了。 本帖最后由 jiahua1010 于 2012-2-18 23:56 编辑
A16:jiahua1010Private Sub Worksheet_Change(ByVal Target As Range)
For i = 2 To Range("d65536").End(xlUp).Row
If Cells(i, 4) - Now() > 3 Then
Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 0
ElseIf Cells(i, 4) <> "" And Cells(i, 5) = "" Then
Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 3
ElseIf Cells(i, 4) <> "" And Cells(i, 5) <> "" Then
Range(Cells(i, 1), Cells(i, 6)).Interior.ColorIndex = 34
End If
Next
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
With Target
If (.Column = 4 Or .Column = 5) And .Row <> 1 Then
If Cells(.Row, 4) = "" Or Cells(.Row, 4) - Now() > 3 Then
Range(Cells(.Row, 1), Cells(.Row, 6)).Interior.ColorIndex = 0
ElseIf Cells(.Row, 4) <> "" And Cells(.Row, 5) = "" Then
Range(Cells(.Row, 1), Cells(.Row, 6)).Interior.ColorIndex = 3
ElseIf Cells(.Row, 4) <> "" And Cells(.Row, 5) <> "" Then
Range(Cells(.Row, 1), Cells(.Row, 6)).Interior.ColorIndex = 34
End If
End If
End With
End Sub Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If (.Column = 4 Or .Column = 5) And .Row <> 1 Then
If Cells(.Row, 4) = "" Or Cells(.Row, 4) - Now() > 3 Then
Range("a" & .Row & ":f" & .Row).Interior.ColorIndex = 0
ElseIf Cells(.Row, 4) <> "" And Cells(.Row, 5) = "" Then
Range("a" & .Row & ":f" & .Row).Interior.ColorIndex = 3
ElseIf Cells(.Row, 4) <> "" And Cells(.Row, 5) <> "" Then
Range("a" & .Row & ":f" & .Row).Interior.ColorIndex = 34
End If
End If
End With
End Sub
C12:hrpotterPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
On Error Resume Next
i = Target.Row
If i > 1 Then
With Range("a" & i & ":f" & i)
If Cells(i, 4) - Now() > 3 Then
.Interior.ColorIndex = 0
ElseIf IsDate(Cells(i, 4)) And IsDate(Cells(i, 5)) = False Then
.Interior.ColorIndex = 3
ElseIf IsDate(Cells(i, 4)) And IsDate(Cells(i, 5)) Then
.Interior.ColorIndex = 34
Else
.Interior.ColorIndex = 0
End If
End With
End If
End Sub 本帖最后由 happym8888 于 2012-2-19 14:28 编辑
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Row = 1 Then Exit Sub
If Cells(.Row, 4) <> "" Then
If Day(Cells(.Row, 4)) - Day(Now()) > 3 Then
Range("A" & .Row & ":F" & .Row).Interior.ColorIndex = 0
ElseIf Cells(.Row, 5) <> "" Then
Range("A" & .Row & ":F" & .Row).Interior.ColorIndex = 34
ElseIf Cells(.Row, 5) = "" Then
Range("A" & .Row & ":F" & .Row).Interior.ColorIndex = 3
End If
End If
End With
End SubC17:Happym8888
D组学委:windimi007
疯子，看效果图，有红色后面就有“过期”，怎么感觉怪怪的？
就用了一个WITH，应该可以吧!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw&
rw = Target.Row
If rw > 1 Then
Application.EnableEvents = False
With Cells(rw, 1).Resize(, 6)
.Interior.ColorIndex = 0
Cells(rw, 7) = ""
If IsDate(Cells(rw, 4)) Then
If Cells(rw, 4) - Date <= 3 Then
If IsDate(Cells(rw, 5)) Then
.Interior.ColorIndex = 34
Else
.Interior.ColorIndex = 3
Cells(rw, 7) = "过期"
End If
End If
End If
End With
Application.EnableEvents = True
End If
End Sub
本帖最后由 dsjohn 于 2012-2-20 16:55 编辑
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg
Rg = Target.Row
Range("a1:f1").Interior.ColorIndex = 0
With Range(Cells(Rg, 1), Cells(Rg, 6))
If IsDate(Cells(Rg, 4).Value) And Not IsDate(Cells(Rg, 5).Value) Then
.Interior.ColorIndex = 3
ElseIf Cells(Rg, 4) - Cells(Rg, 2) > 3 Then
.Interior.ColorIndex = 0
ElseIf IsDate(Cells(Rg, 4).Value) And IsDate(Cells(Rg, 5).Value) Then
.Interior.ColorIndex = 34
End If
End With
End Sub
B017: dsjohn
谢谢了
E05:linch92413 交答案
Private Sub Worksheet_Change(ByVal Target As Range)
Dim N As Long
N = Target.Row
With Range(Cells(N, 1), Cells(N, 5))
If Cells(N, 4) <> "" And Cells(N, 5) = "" Then
.Interior.ColorIndex = 3
ElseIf Cells(N, 4) <> "" And Cells(N, 5) <> "" Then
.Interior.ColorIndex = 34
ElseIf Cells(N, 4).Value - Date > 3 Then
.Interior.ColorIndex = 0
End If
End With
End Sub
本帖最后由 一缕忧兰 于 2012-2-20 18:07 编辑
A07：一缕忧兰
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
With Range(Cells(.Row, "A"), Cells(.Row, "F")).Interior
If Range("D" & Target.Row) <> "" And Range("D" & Target.Row) - Date > 3 Then
.ColorIndex = 0
ElseIf Range("E" & Target.Row) = "" Then
.ColorIndex = 3
ElseIf Range("E" & Target.Row) <> "" Then
.ColorIndex = 34
End If
End With
End With
End Sub