GBKEE

回復 20# c_c_lai

1. Sub Ex_日期數值()
   
2.     Dim i  As Long, xl_Year As Variant
   
3.     With Range("B1:B" & [A1].End(xlDown).Row)
   
4.         .Cells = "=MID(RC[-1],10,10)"
   
5.         .Value = .Value
   
6.         .Replace "發", ""
   
7.         For i = 1 To .Count
   
8.             xl_Year = Split(.Cells(i), "年")
   
9.             xl_Year(0) = xl_Year(0) + 1911 & "年"
   
10.             .Cells(i) = Trim(Join(xl_Year, ""))
    
11.         Next
    
12.         .Cells.Replace "年", "/", xlPart
    
13.         .Cells.Replace "月", "/"
    
14.         .Cells.Replace "日", ""
    
15.         .Offset(, -1).Resize(, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
16.         .Offset(, -1).Resize(, 2).Select         'Offset(, -1) ->左移1欄 'Resize(, 2)  ->擴充為兩欄
    
17.         '.Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
18.     End With
    
19. End Sub

複製代碼

c_c_lai

回復 21# GBKEE
感謝您的指導，我又學到了 .Offset(, -1).Resize(, 2)
的應用，實在非常實用。再次說聲謝謝！

Hsieh

回復 1# freeffly

下載 (96.98 KB)

2013-6-6 23:34

1. Function ChDate(DateStr As String)
   
2. 'DateStr必須是包含"中華民國年月日"的字串
   
3. Dim Mystr As String, s%
   
4.    s = InStr(DateStr, "中華民國") + 4
   
5.    Mystr = Mid(DateStr, s, InStr(s, DateStr, "日") - s + 1)
   
6.    ChDate = CDate(Replace(Mystr, Val(Mystr) & "年", Val(Mystr) + 1911 & "年"))
   
7. End Function

複製代碼

c_c_lai

回復  freeffly
Hsieh 發表於 2013-6-6 23:37

蠻實用的功能函數，感謝您。另外我加上了 Instr() 條件不成立時之處裡：

1. Sub Test()
   
2.     Dim txt As String
   
3.    
   
4.     txt = CEDate([A1])
   
5.     MsgBox IIf(txt = "", """中華民國"" 字串並不存在！", "Year = " & txt)
   
6. End Sub
   
7. 
   
8. Function CEDate(DateStr As String)    ' 「C.E.」是「Common Era」的縮寫，意為「公元」
   
9.     '  DateStr必須是包含"中華民國年月日"的字串
   
10.     Dim Mystr As String, s%
    
11.    
    
12.     s = InStr(DateStr, "中華民國") + 4
    
13.     If s = 4 Then CEDate = "": Exit Function
    
14.     Mystr = Mid(DateStr, s, InStr(s, DateStr, "日") - s + 1)
    
15.     CEDate = CDate(Replace(Mystr, Val(Mystr) & "年", Val(Mystr) + 1911 & "年"))
    
16. End Function

複製代碼

否則會產生以下的錯誤訊息：
執行階段錯誤 '13'：
型態不符合

c_c_lai

回復 23# Hsieh
回復 21# GBKEE
我將 GBKEE 版大的模組、加上 Hsieh 版大提供的 Function，
兩者組合後還蠻實用的：

1. Sub Ex_日期數值3()
   
2.     Dim i  As Long, xl_Year As Variant
   
3.     With Range("B1:B" & [A1].End(xlDown).Row)
   
4.         For i = 1 To .Count
   
5.             .Cells(i) = ChDate(.Cells(i).Offset(, -1))
   
6.             If .Cells(i) <> "" Then .Cells(i).Offset(, 1) = CEDate(.Cells(i))
   
7.         Next
   
8.         '  .Offset(,-1)： 左移 1 欄 (B -> A欄)； Resize(,3)： 從A欄起擴充為三欄 (A、B、C 三欄)
   
9.         '  .Cells(1) = "2012年10月12日"  (B 欄)， .Cells(1).Offset(, 1) = "2012/10/12"  (C 欄)
   
10.         '  .Offset(, -1).Resize(, 3).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
11.         .Offset(, -1).Resize(, 3).Sort Key1:=.Cells(1).Offset(, 1), Order1:=xlAscending, Header:=xlNo
    
12.     End With
    
13. End Sub

複製代碼

1. Function ChDate(DateStr As String)
   
2.     '  DateStr必須是包含"中華民國年月日"的字串
   
3.     Dim Mystr As String, s%
   
4.    
   
5.     s = InStr(DateStr, "中華民國") + 4
   
6.     If s = 4 Then ChDate = "": Exit Function
   
7.     Mystr = Mid(DateStr, s, InStr(s, DateStr, "日") - s + 1)
   
8.     ChDate = Replace(Mystr, Val(Mystr) & "年", Val(Mystr) + 1911 & "年")
   
9. End Function
   
10. 
    
11. Function CEDate(DateStr As String)    '  「C.E.」是「Common Era」的縮寫，意為「公元」
    
12.     CEDate = CDate(DateStr)
    
13. End Function

複製代碼

謝謝兩位版大的鼎力幫忙。

freeffly

回復 23# Hsieh


    謝謝超版回覆
   平常幾乎不會去用自訂函數方式
   又多一個可以研究的東西了