| 楼主 kevinchengcw |
Q: 如何用代码计算指定字符下方最近的含有指定字符且有重复字符的行与本行的差值？ A: 代码如下：
 1.rar |
| 2楼 wumengwen |
给我看看哪块出错了 为什么改完了 只显示2列？ Sub 出现一对相同数字之间向上距离() Dim Arr, Arr2, ArrT, N&, I%, Str$, Dic As Object Set Dic = CreateObject("scripting.dictionary") 'Arr = Range("c2:h" & Cells(Rows.Count, 3).End(3).Row).Value Arr = Range("a2:f" & Cells(Rows.Count, 3).End(3).Row).Value ReDim Arr2(LBound(Arr) To UBound(Arr), LBound(Arr, 2) To LBound(Arr, 2) + 2) With CreateObject("vbscript.regexp") .Global = True .Pattern = "([^,]).*\1" ' For N = UBound(Arr) To LBound(Arr) Step -1 For N = LBound(Arr) To UBound(Arr) Step 1 Str = Arr(N, 1) & "," & Arr(N, 2) & "," & Arr(N, 3) For I = LBound(Arr, 2) To LBound(Arr, 2) + 1 If Dic.exists(Arr(N, I)) And Arr(N, I + 3) >= 10 Then ArrT = Split(Dic(Arr(N, I)), vbTab) Arr2(N, I) = ArrT(UBound(ArrT)) - N + 1 End If If .test(Str) And Str Like "*" & Arr(N, I) & "*" Then If Dic.exists(Arr(N, I)) Then Dic(Arr(N, I)) = Dic(Arr(N, I)) & vbTab & N Else Dic.Add Arr(N, I), N End If End If Next I Next N End With '[I2].Resize(UBound(Arr2), UBound(Arr2, 2)) = Arr2 [G2].Resize(UBound(Arr2), UBound(Arr2, 2)) = Arr2 Set Dic = Nothing End Sub |