|
- Option Explicit
- Sub main()
- Dim irow As Long, iRowMax As Long
- iRowMax = Range("A3").End(xlDown).Row
- Range(Cells(3, 2), Cells(iRowMax, 9)).ClearContents
- Range(Cells(3, 2), Cells(iRowMax, 9)).Interior.Color = xlNone
- For irow = 3 To iRowMax
- Dim str As String
- str = addZero(CStr(Cells(irow, 1).Value))
- Call splitStrAndFill(str, irow)
- Call findRepCellAndColor(irow)
- Cells(irow, 9).Value = absCal(irow)
- Next irow
- End Sub
- Public Function absCal(ByVal irow As Integer)
- Dim i As Integer
- absCal = Abs(Cells(irow, 4).Value - Cells(irow, 5).Value) + Abs(Cells(irow, 4).Value - Cells(irow, 6).Value) + Abs(Cells(irow, 5).Value - Cells(irow, 6).Value)
- End Function
- Public Function findRepCellAndColor(ByVal irow As Integer)
- Dim i As Integer
- For i = 2 To 6
- Dim expRng As String
- expRng = Cells(irow, 2).Address & ":" & Cells(irow, 6).Address
- If Evaluate("=countif(" & expRng & "," & Cells(irow, i).Address & ")") > 1 Then
- Cells(irow, i).Interior.Color = RGB(255, 199, 206)
- Cells(irow, 7).Value = Cells(irow, i).Value
- Cells(irow, 8).Value = Evaluate("=countif(" & expRng & "," & Cells(irow, i).Address & ")")
- End If
- Next i
- End Function
- Public Function splitStrAndFill(ByVal str As String, ByVal irow As Integer)
- Dim i As Integer
- Dim arr(1 To 5)
- For i = 1 To 5
- Cells(irow, i + 1).Value = Mid(str, i, 1)
- Next i
- End Function
- Public Function addZero(ByVal str As String)
- If Len(str) < 5 Then
- Dim i As Integer
- For i = 1 To 5 - Len(str)
- str = "0" & str
- Next i
- End If
- addZero = str
- End Function
复制代码 |
|