工作表事件程序练习1(已结束)

无聊的疯子 · 发表于 2012-2-18 20:52

本帖最后由无聊的疯子于 2012-2-20 20:22 编辑

这是论坛里的一个实列，拆分后拿来做一个Change事件的练习题

代码要求：
with 是必需要使用的，套用越多越好。。但不可重复套用
如 with Range("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 列

效果.gif

Change事件程序练习1.rar (6.59 KB, 下载次数: 175)

冠军欧洲2010 · 发表于 2012-2-18 22:07

本帖最后由冠军欧洲2010 于 2012-2-18 22:10 编辑

游客，如果您要查看本帖隐藏内容请回复

szczm121 · 发表于 2012-2-18 23:23

我只是看得眼花缭乱，只有羡慕的份了。

jiahua1010 · 发表于 2012-2-18 23:51

本帖最后由 jiahua1010 于 2012-2-18 23:56 编辑

A16:jiahua1010

Private 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 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(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

复制代码

hrpotter · 发表于 2012-2-18 23:59

C12:hrpotter

Private 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 01:33

本帖最后由 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 Sub

复制代码

C17:Happym8888

windimi007 · 发表于 2012-2-19 10:44

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-19 11:47

本帖最后由 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
谢谢了

linch92414 · 发表于 2012-2-19 12:28

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

Change事件程序练习1(linch92413).rar (9.67 KB, 下载次数: 13)

一缕忧兰 · 发表于 2012-2-19 14:28

本帖最后由一缕忧兰于 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

		自动登录	找回密码
密码			注册

[练习题] 工作表事件程序练习1(已结束)

评分

相关帖子

点评

评分

评分

点评

评分

点评

评分

点评

评分

点评

点评

评分