[已解决]如何用代码历遍工作表标色？

dfshm

附件 历遍工作表标黄色.zip (41.4 KB, 下载次数: 11)

2013-12-24 13:34 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2013-12-24 16:46

dfshm 发表于 2013-12-24 16:30
老师您好，谢谢帮助。需要一个代码，要把代码粘到其它工作薄中，您写的程序好象有两层。

能把代码贴出 ...

可以只用模块一的代码就可以了。

1. Sub 标色()
   
2. Dim i&, j As Byte, k As Byte, m%
   
3. Dim sh As Worksheet, r&, c&
   
4. For j = 2 To Sheets.Count
   
5.     With Sheets(j)
   
6.          r = .Range("a" & Rows.Count).End(3).CurrentRegion.Rows.Count + .Range("a" & Rows.Count).End(3).CurrentRegion.Row - 1
   
7.          c = .Range("a" & Rows.Count).End(3).CurrentRegion.Columns.Count + .Range("a" & Rows.Count).End(3).CurrentRegion.Column - 1
   
8.         For i = 1 To r
   
9.             If .Range("a" & i).Interior.ColorIndex = xlNone Then
   
10.               
    
11.                 For n = 1 To r
    
12.                     For k = 2 To c
    
13.                        If .Cells(n, k).Interior.ColorIndex = 3 Then
    
14.                             .Cells(n, 1).Interior.ColorIndex = 6
    
15.                             GoTo 100
    
16.                        End If
    
17.                    Next k
    
18. 100:
    
19.                Next n
    
20.             End If
    
21.         Next i
    
22.     End With
    
23. Next j
    
24. End Sub
    

复制代码

跳转到最佳答案楼层

yyyydddd8888

因为要循环单元格，所以比较慢：
历遍工作表标黄色.rar (33.95 KB, 下载次数: 9)

2013-12-24 14:19 上传

点击文件名下载附件

dfshm

yyyydddd8888 发表于 2013-12-24 14:19
因为要循环单元格，所以比较慢：

老师您好，谢谢帮助。需要一个代码，要把代码粘到其它工作薄中，您写的程序好象有两层。

能把代码贴出来吗？

yyyydddd8888

dfshm 发表于 2013-12-24 16:30
老师您好，谢谢帮助。需要一个代码，要把代码粘到其它工作薄中，您写的程序好象有两层。

能把代码贴出 ...

可以只用模块一的代码就可以了。

1. Sub 标色()
   
2. Dim i&, j As Byte, k As Byte, m%
   
3. Dim sh As Worksheet, r&, c&
   
4. For j = 2 To Sheets.Count
   
5.     With Sheets(j)
   
6.          r = .Range("a" & Rows.Count).End(3).CurrentRegion.Rows.Count + .Range("a" & Rows.Count).End(3).CurrentRegion.Row - 1
   
7.          c = .Range("a" & Rows.Count).End(3).CurrentRegion.Columns.Count + .Range("a" & Rows.Count).End(3).CurrentRegion.Column - 1
   
8.         For i = 1 To r
   
9.             If .Range("a" & i).Interior.ColorIndex = xlNone Then
   
10.               
    
11.                 For n = 1 To r
    
12.                     For k = 2 To c
    
13.                        If .Cells(n, k).Interior.ColorIndex = 3 Then
    
14.                             .Cells(n, 1).Interior.ColorIndex = 6
    
15.                             GoTo 100
    
16.                        End If
    
17.                    Next k
    
18. 100:
    
19.                Next n
    
20.             End If
    
21.         Next i
    
22.     End With
    
23. Next j
    
24. End Sub
    

复制代码