[已解决]31天中判断“A，B，C”开头之间距离

zhanmude

距离.zip (10.84 KB, 下载次数: 19)

2014-5-21 22:48 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2014-5-22 11:05

请看附件。附件里代码略有改动，考虑了最大列的边界问题。

1. Sub tt()
   
2.     Range("ag:ag").ClearContents
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         xstr = "":  n = 0: s = 0
   
6.         For j = 1 To UBound(arr, 2)
   
7.             x = Left(arr(i, j), 1)
   
8.             If InStr("ABC", x) > 0 And Len(x) > 0 Then
   
9.                 s = s + 1
   
10.             Else
    
11.                 If s >= 7 Then
    
12.                     n = n + 1
    
13.                     xstr = xstr & "," & Cells(i, j - 1).Address
    
14.                 End If
    
15.                 s = 0
    
16.             End If
    
17.             If j = UBound(arr, 2) And s >= 7 Then
    
18.                  n = n + 1
    
19.                  xstr = xstr & "," & Cells(i, j).Address
    
20.             End If
    
21.         Next
    
22.         If n > 0 Then
    
23.             Cells(i, "ag") = "已有" & n & "次超出7天，是" & Mid(Replace(xstr, "$", ""), 2)
    
24.         Else
    
25.             Cells(i, "ag") = "无"
    
26.         End If
    
27.     Next
    
28. End Sub
    
29. 
    

复制代码

跳转到最佳答案楼层

cbg2008

不会

grf1973

1. Sub tt()
   
2.     Range("ag:ag").ClearContents
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         xstr = "":  n = 0: s = 0
   
6.         For j = 1 To UBound(arr, 2)
   
7.             x = Left(arr(i, j), 1)
   
8.             If InStr("ABC", x) > 0 And Len(x) > 0 Then
   
9.                 s = s + 1
   
10.             Else
    
11.                 If s >= 7 Then
    
12.                     n = n + 1
    
13.                     xstr = xstr & "," & Cells(i, j - 1).Address
    
14.                 End If
    
15.                 s = 0
    
16.             End If
    
17.         Next
    
18.         If n > 0 Then
    
19.             Cells(i, "ag") = "已有" & n & "次超出7天，是" & Mid(Replace(xstr, "$", ""), 2)
    
20.         Else
    
21.             Cells(i, "ag") = "无"
    
22.         End If
    
23.     Next
    
24. End Sub
    
25. 
    
26. 
    

复制代码

grf1973

请看附件。附件里代码略有改动，考虑了最大列的边界问题。

1. Sub tt()
   
2.     Range("ag:ag").ClearContents
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         xstr = "":  n = 0: s = 0
   
6.         For j = 1 To UBound(arr, 2)
   
7.             x = Left(arr(i, j), 1)
   
8.             If InStr("ABC", x) > 0 And Len(x) > 0 Then
   
9.                 s = s + 1
   
10.             Else
    
11.                 If s >= 7 Then
    
12.                     n = n + 1
    
13.                     xstr = xstr & "," & Cells(i, j - 1).Address
    
14.                 End If
    
15.                 s = 0
    
16.             End If
    
17.             If j = UBound(arr, 2) And s >= 7 Then
    
18.                  n = n + 1
    
19.                  xstr = xstr & "," & Cells(i, j).Address
    
20.             End If
    
21.         Next
    
22.         If n > 0 Then
    
23.             Cells(i, "ag") = "已有" & n & "次超出7天，是" & Mid(Replace(xstr, "$", ""), 2)
    
24.         Else
    
25.             Cells(i, "ag") = "无"
    
26.         End If
    
27.     Next
    
28. End Sub
    
29. 
    

复制代码

su45

进来看下他人的代码