Dim CurRow As Long
Dim CurColumn As Long
Dim FinalRow As Long
Dim TempRow As Long
CurRow = Target.Row '得到当前行
CurColumn = Target.Column '得到当前列
FinalRow = Worksheets("sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row '得到最后一行
Application.EnableEvents = False '禁止发生重复中断
Application.ScreenUpdating = False '禁止屏幕更新
If CurRow > 6 And (CurColumn > 6 And CurColumn < 11) Then '如果G:J列满足对应的列要求
Worksheets("sheet1").Cells(CurRow, 13) = Now '则在对应的M列填写当前的系统日期和时间
Else
Application.ScreenUpdating = True '允许屏幕更新
Application.EnableEvents = True '允许再次发生中断
Exit Sub
End If
For TempRow = 7 To FinalRow Step 1 '从第 7行开始到最后一行进行检查
If Worksheets("sheet1").Cells(TempRow, 13) <> Empty Then '如果当前行的M列不为空
If Int(Worksheets("sheet1").Cells(TempRow, 13)) <> Date Then '且当前行的M列日期不等于当前的系统日期
Worksheets("sheet1").Cells(TempRow, 13).Interior.ColorIndex = xlColorIndexNone '去掉背景色
Else '否则, 即等于当前系统日期
Worksheets("sheet1").Cells(TempRow, 13).Interior.ColorIndex = 3 '将对应的E列背景色改为红色
End If
End If
Next TempRow
Application.ScreenUpdating = True '允许屏幕更新
Application.EnableEvents = True '允许再次发生中断
End Sub
'我希望实现的是：
'1、当我更新G：J列并>6行 (如果控制在<1000行会不会加快速度) 时，M列能自动记录我的更新的时间，并用红色突出显示最近一天的所有更新记录...
' 这个问题您上面的程序已经帮我解决了，但我发现在个小问题，就是每次M列更新后，撤消的记录都被清空了， _
撤消这个功能对我来说非常重要，万一有时候不小心弄错了哪里，又不知道原来单元格是什么参数，不能撤消一步，那不就会死的很惨....
'
'2、和第1个问题差不多，就是更新右边配置的时候，更新时间记录在另一列N上
' 当我更新S:FP列(19-172列)中奇数列，并>6行时，N列才能自动记录我的更新的时间，并用粉红色突出显示最近一天的所有更新记录...
' 偶数列20 22 24 ...递增不写了...172(就是我隐藏了的列)，这些列有公式是变量，每天都要计算需求数量，所以我不希望N列记录它们的更新时间....
'
'3、下面的程序能否实现第2个要求？ 如果可以，怎么合并上下两个程序？如果没什么用那就不用管它了...
'
'4、我想分别在M5和N5两个位置设两个按钮，这两个按钮功能是一样，只是一个是控制M列的，另一个是控制N列，要实现下面的功能这两个按钮会不会有冲突...
' 需要实现：只显示最近更新的(？)天的行，其它行隐藏，这里的问号(？)代表的是可选，
' 例如：像用微调按钮调整到5天，就只显示最近5天内更新过的行，其它行隐藏...
' 或者是象选择日期时间表(附图)一样选择到某一天，那就只显示某一天到今天有过更新的行，其它行隐藏...
'
'5、K3这位置有个按钮“点击生成打印报表”，我觉得这个按钮挺好的，可是我们领导说这个按钮还没有达到他希望的要求.........
' 这个按钮一般都是最后按的，都在产生需求数量后点一下，他希望点击这个按钮后实现： _
5.1、按O列筛选并>6行以下的，只显示需求数量>0的行，其它行隐藏 _
5.2、再复制整个工作表 _
5.3、新建另一个新的工作薄 _
5.4、粘贴，再复制选择性粘贴以数值粘贴，就是为了保留格式，去掉公式 _
5.5、删除所有隐藏了的行，就是O列没有需求数量的行，包括第1和2行，但要保留3、4、5、6行， _
因为这是打印顶端标题行，然后删除6行(如果1、2已删，那这就是第4行)以下所有隐藏了的行 _
(第5.1条和第5.4条是不是可以放在一起执行) _
5.6、删除B：F列(隐藏中)和F，H：I，再删除S：IV列 _
5.7、P4单元格筛选，以降序排列 _
5.8、完成(例如"sheet2"的样子)
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False '关闭屏幕刷新
Dim intRow&, intCol&, i&, MaxTime As Date
intRow = Target.Row '记录行号
intCol = Target.Column '记录列号
'当更新的范围在3行以后，S:FP列之内时执行
If intRow > 6 And (inCol >= 20 And inCol <= 172 And inCol Mod 2 = 0) Then
Cells(intRow, 14) = Now() '将现在时刻记录在N列
'由于记录的都是历史日期和时间，所以求离今天日期即求N列最大值
'求N列最大值
MaxTime = WorksheetFunction.Max(Range("N7:N" & Range("N65536").End(xlUp).Row))
Range("N7:N" & Range("N65536").End(xlUp).Row).Interior.ColorIndex = xlNone '消除所有颜色
With Sheet6 '将范围限定在Sheet6，加快速度
For i = 7 To Range("N65536").End(xlUp).Row '从第七行一直到数据记录最后一行开始循环
'当日期=Maxtime是就变色
If Year(MaxTime) = Year(.Cells(i, 14)) And Month(MaxTime) = Month(.Cells(i, 14)) And _
Day(MaxTime) = Day(.Cells(i, 14)) Then .Cells(i, 14).Interior.ColorIndex = 7
Next i
End With
End If
Application.ScreenUpdating = True '开启屏幕刷新
End Sub
(344 KB, 下载次数: 12)