|
发表于 2013-11-22 15:26
|
显示全部楼层
本楼为最佳答案
附件请测试,注意,运行时间比较长,我是2003版,只有256列- Private Sub CommandButton1_Click()
- Application.ScreenUpdating = False
- Dim sh As Worksheet, a1&, a2&, a3&, i&, j&, k&, arr, r&, r1&
- For Each sh In Worksheets
- If sh.Name <> "Sheet1" Then
- arr = sh.UsedRange
- r = sh.[a65536].End(3).Row
- a1 = sh.Cells(r, 1): a2 = sh.Cells(r - 1, 1): a3 = sh.Cells(r - 2, 1)
- For j = 2 To UBound(arr, 2)
- For i = UBound(arr) To 3 Step -1
- If arr(i, j) = a1 Then If arr(i - 1, j) = a2 Then If arr(i - 2, j) = a3 And r - i <> 0 Then sh.Range(sh.Cells(1, j), sh.Cells(r - i, j)).Insert Shift:=xlDown: Exit For
- Next i
- Next j
- arr = sh.Range("a1:iv" & sh.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
- For i = 1 To r - 3
- If arr(i, 1) <> "" Then
- For j = 2 To UBound(arr, 2)
- If arr(i, j) = arr(i, 1) Then sh.Cells(i, j).Interior.Color = vbRed
- Next j
- End If
- Next i
- End If
- Next sh
- Application.ScreenUpdating = True
- End Sub
复制代码 |
评分
-
查看全部评分
|