Excel VBA基于RGB颜色剪切粘贴行的宏运行失效问题
宏运行故障原因排查
你的第二个剪切粘贴宏无法正常工作,共有3个核心问题:
- 颜色读取逻辑错误:第一个宏里的红、黄、橙填充色都是通过条件格式生成的显示效果,不是单元格原生设置的固定填充色。你代码里用的
TransIDCell.Interior.Color只能读取单元格手动设置的固定填充属性,完全识别不到条件格式渲染出来的颜色,判断条件永远不成立,自然不会触发剪切操作。 - 源工作表指定错误:回顾第一个宏的执行逻辑:你是先把
Down Weekly工作表的原始数据复制到新建的DNIF表,之后才在DNIF表上添加条件格式着色、执行排序,原始的Down Weekly表全程没有做任何着色处理。第二个宏把源表设为Down Weekly,从一开始就找错了取数位置。 - 遍历逻辑存在漏洞:你采用从上到下的正向遍历方式,每剪切走一行,下方的所有行都会自动上移一行,会直接跳过部分单元格,导致漏处理数据。
修正后的可运行代码
调整点对应上述问题:将源表改为实际存有着色数据的DNIF工作表,用DisplayFormat.Interior.Color读取条件格式生成的显示颜色,改为从最后一行向上倒序遍历避免漏行,同时补上了橙色(<30天)行的剪切逻辑,和你第一个宏创建的工作表一一对应:
Sub Copier() Dim TransIDCell As Range Dim OriginSheet As Worksheet Dim TargetPreg As Worksheet Dim TargetWx As Worksheet Dim TargetLess30 As Worksheet Dim lastRow As Long, i As Long ' 绑定工作表 Set OriginSheet = Worksheets("DNIF") ' 修正源表为实际着色的DNIF表 Set TargetPreg = Worksheets("Preg") Set TargetWx = Worksheets("Wx") Set TargetLess30 = Worksheets("<30") ' 获取G列最后一行行号,确定遍历范围 lastRow = OriginSheet.Cells(OriginSheet.Rows.Count, "G").End(xlUp).Row ' 倒序遍历,避免剪切行导致的位置偏移漏数 For i = lastRow To 2 Step -1 Set TransIDCell = OriginSheet.Cells(i, "G") ' 用DisplayFormat读取条件格式渲染的实际显示颜色 Select Case TransIDCell.DisplayFormat.Interior.Color Case RGB(255, 0, 0) ' 红色,对应Preg表 TransIDCell.Resize(1, 7).Cut _ Destination:=TargetPreg.Cells(TargetPreg.Rows.Count, "A").End(xlUp).Offset(1, 0) Case RGB(255, 255, 0) ' 黄色,对应Wx表 TransIDCell.Resize(1, 7).Cut _ Destination:=TargetWx.Cells(TargetWx.Rows.Count, "A").End(xlUp).Offset(1, 0) Case RGB(255, 192, 0) ' 橙色,对应<30表 TransIDCell.Resize(1, 7).Cut _ Destination:=TargetLess30.Cells(TargetLess30.Rows.Count, "A").End(xlUp).Offset(1, 0) End Select Next i End Sub
注意:如果你使用的是2007以前的老版本Excel,
DisplayFormat属性不被支持,这种情况可以直接把第一个宏的条件格式着色逻辑改成遍历单元格直接设置固定填充色,就能直接用Interior.Color正常读取颜色值了。
内容的提问来源于stack exchange,提问作者Brandon Knotts
相关产品推荐
相关产品推荐

