|
本帖最后由 Excel学徒123 于 2017-1-18 14:12 编辑
- Sub Test()
- Dim arrSrc
- Dim iCnt%, irow%
- Dim objdic As Object
- Set objdic = CreateObject("scripting.dictionary")
- arrSrc = Range("a1").CurrentRegion.Value
- For irow = 2 To UBound(arrSrc) - 1
- If arrSrc(irow, 1) & arrSrc(irow, 3) = arrSrc(irow + 1, 1) & arrSrc(irow + 1, 3) And _
- arrSrc(irow + 1, 2) = arrSrc(irow, 2) + 1 Then
- iCnt = iCnt + 1
- If iCnt >= 4 Then
- If Not objdic.exists(arrSrc(irow, 1)) Then
- objdic.Add arrSrc(irow, 1), ""
- End If
- End If
- Else
- iCnt = 0
- End If
- Next
- Range("e1").Resize(objdic.Count) = Application.Transpose(objdic.keys)
- End Sub
复制代码 用的VBA,没用公式,你自己参考吧 |
|