|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 活在理想的世界 于 2017-11-18 17:22 编辑
- Private Sub Worksheet_Activate()
- Application.ScreenUpdating = False
- Dim arr(), brr(1 To 1048576, 1 To 10), sht As Worksheet, w As WorksheetFunction
- Set w = WorksheetFunction
- For Each sht In Sheets
- If sht.Name <> Sheet1.Name And w.CountA(sht.Cells) <> 0 Then
- k = sht.Range("a1048576").End(3).Row - 2
- h = sht.Range("a2").End(2).Column
- arr = sht.Range("a3").Resize(k, h)
- For r = 1 To UBound(arr)
- If arr(r, 20) <= 3 And arr(r, 20) <> "" Then
- i = i + 1
- brr(i, 1) = arr(r, 3)
- brr(i, 2) = arr(r, 2)
- brr(i, 3) = arr(r, 7)
- brr(i, 4) = arr(r, 10)
- brr(i, 5) = arr(r, 9)
- brr(i, 6) = arr(r, 13)
- brr(i, 7) = arr(r, 14)
- brr(i, 8) = arr(r, 19)
- brr(i, 9) = arr(r, 20)
- If brr(i, 9) = 0 Then
- brr(i, 10) = "超期当日"
- Else
- brr(i, 10) = "小于" & brr(i, 9) & "天"
- End If
- End If
- Next
- End If
- Next
- Sheet1.Range("b6").Resize(10000, 10).ClearContents
- Sheet1.Range("b6").Resize(i, 10) = brr
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|