感觉我又想复杂了好像,为什么没有人和我一起做这道题目,让我学习一下
- Option Explicit
- Sub today1() '两个单元格颜色
- Dim rng As Range, rg As Range, i&, ys$, y&, r&, x&, lh&, hh&
- With Sheets("Sheet1")
- Set rng = .Range("a1").CurrentRegion
- hh = rng.Cells(rng.Rows.Count, rng.Columns.Count).Row
- lh = rng.Cells(rng.Rows.Count, rng.Columns.Count).Column
- ys = .[e1].Interior.ColorIndex & "," & .[e2].Interior.ColorIndex
- ys = "," & ys & "," & ys & ","
-
- For Each rg In rng
- y = rg.Offset(0, 1).Interior.ColorIndex: x = rg.Offset(1, 0).Interior.ColorIndex
- r = rg.Interior.ColorIndex
- If rg.Row < hh And InStr(ys, "," & r & "," & x & ",") Then i = i + 1
- If rg.Column < lh And InStr(ys, "," & r & "," & y & ",") Then i = i + 1
- Next
- .[f2] = i
- End With
- End Sub
- Function gss(rng As Range, bz As Range) '两个单元格颜色
- Dim rg As Range, i&, ys$, y&, r&, x&, lh&, hh&, rr As Range
- If bz.Count > 2 Then gss = "": Exit Function
- hh = rng.Cells(rng.Rows.Count, rng.Columns.Count).Row
- lh = rng.Cells(rng.Rows.Count, rng.Columns.Count).Column
- For Each rr In bz
- ys = ys & "," & rr.Interior.ColorIndex
- Next
- ys = ys & ys & ","
-
- For Each rg In rng
- y = rg.Offset(0, 1).Interior.ColorIndex: x = rg.Offset(1, 0).Interior.ColorIndex
- r = rg.Interior.ColorIndex
- If rg.Row < hh And InStr(ys, "," & r & "," & x & ",") Then i = i + 1
- If rg.Column < lh And InStr(ys, "," & r & "," & y & ",") Then i = i + 1
- Next
- gss = i
- End Function
复制代码
|