- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 253
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-11-22
              
|
2#
發表於 2014-2-14 10:03
| 只看該作者
回復 1# gn00487767
一鍵搞定- Private Sub CommandButton2_Click()
- Dim Ar()
- With Sheets("名單")
- For Each a In .Range(.[E2], .[E2].End(xlDown)).SpecialCells(xlCellTypeConstants)
- ReDim Preserve Ar(s)
- n = Application.HLookup(a, Array(Array("第一類", "第二類", "第三類", "第四類", "第五類"), Array(5, 3, 1, 0, 8)), 2, 0)
- y = DateAdd("m", n, a.Offset(, 1))
- Ar(s) = Array(y, n, IIf(Date > y, "有效", "無效"))
- s = s + 1
- Next
- End With
- ay = Application.Transpose(Application.Transpose(Ar))
- With Sheets("驗證")
- .Range(.[B2], .[B2].End(xlDown)).ClearContents
- .[B2].Resize(s, 1) = Application.Index(ay, , 1)
- .Range(.[E2], .[E2].End(xlDown)).ClearContents
- .[E2].Resize(s, 1) = Application.Index(ay, , 2)
- End With
- With Sheets("結果")
- .Range(.[B2], .[B2].End(xlDown)).ClearContents
- .[B2].Resize(s, 1) = Application.Index(ay, , 3)
- End With
- End Sub
|
|
發表於 2014-2-16 01:00
| 
