请求帮助输入公式谢谢

hxl7806

请求帮助输入公式谢谢 111.rar (69.36 KB, 下载次数: 19)

2009-8-14 13:08 上传

点击文件名下载附件

xiangzi728

111.rar (70.77 KB, 下载次数: 14)

2009-8-14 13:27 上传

点击文件名下载附件

hxl7806

谢谢xiangzi728

蓝桥玄霜

1. Sub lenr()
   
2. Dim Myr&, Arr, le, re, x&
   
3. Myr = [a65536].End(xlUp).Row
   
4. Arr = Range("gr3:gs" & Myr)
   
5. For x = 1 To UBound(Arr)
   
6.     If Cells(x + 2, "fy").Value < 16 Then
   
7.         Arr(x, 1) = "热"
   
8.         le = le + 1
   
9.         re = 0
   
10.         Arr(x, 2) = le
    
11.     Else
    
12.         Arr(x, 2) = "冷"
    
13.         le = 0
    
14.         re = re + 1
    
15.         Arr(x, 1) = re
    
16.     End If
    
17. Next x
    
18. [gr3].Resize(UBound(Arr), 2) = Arr
    
19. End Sub
    

复制代码

hxl7806

谢谢蓝桥玄霜 太好了!