统计连续个数

gfs57

各位：午安!

         统计连续3个及以上的“×”，在最后那个“×”的右 边写上起始的序号。希望达到右边的效果。不知道用什么方法能快速达到。

        谢谢 !

jiminyanyan

那些计是什么“鬼”

qingc0221

1. Sub 统计个数()
   
2.     Dim LastRow As Long, Row As Long, R1 As Integer, R2 As Integer, Counter As Integer
   
3.     LastRow = Cells(Rows.Count, 1).End(xlUp).Row
   
4.     Range("C:C").ClearContents
   
5.     Range("A:B").Interior.Color = xlNone
   
6.     For Row = 2 To LastRow
   
7.         If Cells(Row, 2) = "×" And Counter = 0 Then
   
8.             Counter = 1
   
9.             R1 = Row
   
10.         ElseIf Cells(Row, 2) <> "√" Then
    
11.             Counter = Counter + 1
    
12.             If Cells(Row + 1, 2) = "√" Then
    
13.                 If Cells(Row, 2) = "" Then
    
14.                     R2 = Row - 1
    
15.                 Else
    
16.                     R2 = Row
    
17.                 End If
    
18.                 If Counter > 3 Then
    
19.                     Cells(R2, 3) = Cells(R1, 1) & "-" & Cells(R2, 1)
    
20.                     Range(Cells(R1, 2), Cells(R2, 2)).Interior.Color = 5296274
    
21.                 End If
    
22.             End If
    
23.         ElseIf Cells(Row, 2) = "√" Then
    
24.             Counter = 0
    
25.         End If
    
26.     Next Row
    
27. End Sub

复制代码

gfs57

qingc0221 发表于 2017-5-7 17:08

谢谢你的回复。经试，能用。

　　下面的附件有个新问题，再次麻烦你帮着看看。再谢！

　　序号20与序号21之间有个空行，还有一个标题行。（也就是说每个小表格有20个序号，两个小表格之间有个空行）。

　　希望上个表格末尾的“×”能连到下个表一起计算。

qingc0221

1. Sub 统计个数()
   
2.     Dim LastRow As Long, Row As Long, R1 As Integer, R2 As Integer, Counter As Integer
   
3.     LastRow = Cells(Rows.Count, 1).End(xlUp).Row
   
4.     Range("C:D").ClearContents
   
5.     Range("A:B").Interior.Color = xlNone
   
6. 
   
7.     For Row = 2 To LastRow
   
8.         If Counter = 0 Then
   
9.             If Cells(Row, 2) = "×" Then
   
10.                 Counter = 1
    
11.                 R1 = Row
    
12.             End If
    
13.         ElseIf Cells(Row, 2) <> "√" Then
    
14.             Counter = Counter + 1
    
15.             If Cells(Row + 1, 2) = "√" Then
    
16.                 If Cells(Row, 2) = "" Then
    
17.                     R2 = Row - 1
    
18.                 Else
    
19.                     R2 = Row
    
20.                 End If
    
21.                 If Counter > 3 Then
    
22.                     Cells(R2, 3) = Cells(R1, 1) & "-" & Cells(R2, 1)
    
23.                     Range(Cells(R1, 2), Cells(R2, 2)).Interior.Color = 5296274
    
24.                 End If
    
25.             End If
    
26.         ElseIf Cells(Row, 2) = "√" Then
    
27.             Counter = 0
    
28.         End If
    
29.         Cells(Row, 4) = Counter
    
30.     Next Row
    
31. End Sub

复制代码

gfs57

qingc0221 发表于 2017-5-7 21:46

你好 !
　　感谢你的回复！效果挺好的。

　　又出现一种情况：就是上页末尾一行(或两行)出现“×”，而下一页首行不是“×”的，会出错。如图

　　请帮我再想想办法。老是麻烦你，不好意思。

       谢谢 !

gfs57

qingc0221 发表于 2017-5-7 21:46

你好!没在线是吗？

konka--

1. Function 提取(s$, j%)
   
2.     Dim reg As Object, i%, mh As Object
   
3.     Dim arr, mhk
   
4.     Set reg = CreateObject("vbscript.regexp")
   
5.     reg.Pattern = "\d+\.?\d+(CM|mm|M|米|)"
   
6.     reg.Global = True
   
7.     Set mh = reg.Execute(s)
   
8.     If reg.test(s) Then
   
9.         ReDim arr(1 To mh.Count)
   
10.         For Each mhk In mh
    
11.             i = i + 1
    
12.             arr(i) = dan(mhk.Value)
    
13.         Next
    
14.         'If mh.Count < j Then Exit Function
    
15.         If mh.Count < j Then
    
16.             提取 = ""
    
17.         Else
    
18.             提取 = arr(j)
    
19.         End If
    
20.     End If
    
21. End Function
    
22. Function dan(a$)
    
23.     If InStr(a, "CM") Then
    
24.         dan = Replace(a, "CM", "") * 10
    
25.     Else
    
26.         If InStr(a, "米") Or InStr(a, "M") Then
    
27.             dan = Replace(Replace(a, "米", ""), "M", "") * 1000
    
28.         Else
    
29.             dan = Replace(a, "mm", "")
    
30.         End If
    
31.     End If
    
32. End Function

复制代码

=提取(单元格,COLUMN(A1))

qingc0221

定义两个变量R1,R2来记录×的起始和结尾行号
定义一个计数变量n来记录×的数目
n=0时向下找到第一个×时,行号赋值给R1
如果第二列是√或已到尾行,且n大于等于3时,反向查找最后一个×的行号赋值给R2
R1-R2之间填充颜色就行
n小于3或者填充完颜色后n归零继续向下

你自己可以研究一下

gfs57

qingc0221 发表于 2017-5-8 23:17
定义两个变量R1,R2来记录×的起始和结尾行号
定义一个计数变量n来记录×的数目
n=0时向下找到第一个×时, ...

好的。谢谢你!