请问怎么将输入的字体默认为红色

啵啵岚

就是我现在每天给导师提交今天的数据，导师要求当天新增的内容用红色字体标注，我每天都是写好之后再调格式。
由于每日的数据都是在原有数据的基础上新增，每天反馈的数据分布在不同sheets  不同range  不能一键调好  所以每天都要调整N次
所以产生了如下需求：
加入我今天打开工作簿，里面有5个sheets：
里面有之前写好数据，他们都是黑色字体，这些不用管。
我会在每个sheets里都新增一部分内容，我希望这些内容在我输入的时候自动为红色字体，不要我输完了之后再一个个调整。
我上传了一个附件，假如我今天要输入3月3号的数据，怎么自动为红色字体呢？
请求大佬帮帮忙，这每天一个个调要吐掉了

yxbaju

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Target.Font.Color = -16776961

复制代码

我有个菜鸡办法, 每个工作表事件写上这个,不想变红的时候就给注释掉

啵啵岚

hh   我自己也想了个土办法  每次输入的时候 都直接选中多个空白行 字体设置为红色 然后再输入就好了
不过这样 换个sheet或range的时候  都要重新设置一下  
不过已经比之前每行写好后都调一次字体好多了

micch

添加一列日期，对数据进行自动标注，根据日期条件格式？？

啵啵岚

yxbaju 发表于 2020-3-3 20:28
我有个菜鸡办法, 每个工作表事件写上这个,不想变红的时候就给注释掉

哇 我试了下你这  可以在单个sheet里实现  能把这个变成工作簿事件就好了  我去翻翻书 想想办法  能编程工作簿事件就完全符合需求了

micch

在thisworkbook里添加事件，可以加一个打开就激活的代码输入红色，关闭前执行全部变回黑色

啵啵岚

yxbaju 发表于 2020-3-3 20:28
我有个菜鸡办法, 每个工作表事件写上这个,不想变红的时候就给注释掉

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Target.Font.Color = -16776961
End Sub


改成  这个 好像可以了呢

啵啵岚

micch 发表于 2020-3-3 21:41
在thisworkbook里添加事件，可以加一个打开就激活的代码输入红色，关闭前执行全部变回黑色

哇  大佬回复了 感激不尽  我参考别人的实现需求啦 HH  
这个我今天的数据就是要红色字体的 关闭前不用变黑色啦   已经搞定了  非常感谢您。

shenjianrong163

将下面的代码放入新的.xls文件中，将要设置颜色的文件与本文件放在同一个文件夹中，执行本文件的代码即可。

1. Sub test()
   
2.     Dim i, arr
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     For Each f In fso.getfolder(ThisWorkbook.Path).Files
   
7.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
8.             With Workbooks.Open(f)
   
9.                 For Each sht In .Sheets
   
10.                     sht.UsedRange.Font.ColorIndex = xlAutomatic
    
11.                     arr = sht.UsedRange
    
12.                     For i = 1 To UBound(arr)
    
13.                         If arr(i, 1) = Val(Month(Now()) & "." & Day(Now())) Then
    
14.                         sht.Rows(i).Font.ColorIndex = 3
    
15.                         End If
    
16.                     Next
    
17.                     Erase arr
    
18.                 Next sht
    
19.                 .Close True
    
20.             End With
    
21.         End If
    
22.     Next f
    
23.     Application.DisplayAlerts = True
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "设置完成！"
    
26. End Sub

复制代码

shenjianrong163

请参考附件：


设置颜色.rar (18.44 KB, 下载次数: 71)

2020-3-3 22:20 上传

点击文件名下载附件
1