Board logo

標題: [發問] 請問如何將內容有中華民國日期的字眼抓出來轉成西元日期? [打印本頁]
作者: freeffly    時間: 2013-5-30 16:07     標題: 請問如何將內容有中華民國日期的字眼抓出來轉成西元日期?

我想要在B欄顯示A欄對應的西元日期
請問有辦法做到嗎?

[attach]15110[/attach]
作者: GBKEE    時間: 2013-5-30 17:01

回復 1# freeffly
  1. Sub Ex()
  2.     Dim R As Range, xl_Year As Integer
  3.     Set R = [A1]
  4.     Do While R <> ""
  5.         If InStr(R, "中華民國") Then
  6.         'InStr 函數 傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
  7.             xl_Year = Mid(R, InStr(R, "中華民國") + 4, InStr(R, "年") - InStr(R, "中華民國") - 4) '年度
  8.             R = Replace(R, xl_Year, xl_Year + 1911)
  9.             R = Replace(R, "中華民國", "")
  10.         End If
  11.         Set R = R.Offset(1)
  12.         Loop
  13. End Sub
複製代碼
作者: freeffly    時間: 2013-5-30 17:14

回復 2# GBKEE


    謝謝超版相救
   不過這各與我要的有點差異
   我是要在B欄做一個西元日期
   
   因為我要對這些資料排序
   
   剛剛想到用mid+find+Right+left這幾各函數的方式去做
   暫時算是先解決了
作者: GBKEE    時間: 2013-5-30 17:37

本帖最後由 GBKEE 於 2013-5-30 17:48 編輯

回復 3# freeffly
  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.     End With
  13. End Sub
複製代碼
作者: HSIEN6001    時間: 2013-5-30 19:58

本帖最後由 HSIEN6001 於 2013-5-30 19:59 編輯

回復 3# freeffly

也許這是你要的  ^+++^
   =MID(A1,FIND("年",A1)-3,3)+1911&"/"&MID(A1,FIND("年",A1)+1,(FIND("月",A1)-FIND("年",A1)-1))&"/"&MID(A1,FIND("月",A1)+1,(FIND("　",A1)-FIND("月",A1)-2))
=2013/2/23
作者: Hsieh    時間: 2013-5-30 20:20

回復 1# freeffly

[attach]15112[/attach]
作者: freeffly    時間: 2013-5-31 09:09

回復 4# GBKEE


    再次感謝不過他不算日期格式
   用來排序無法達到效果
作者: freeffly    時間: 2013-5-31 09:10

本帖最後由 freeffly 於 2013-5-31 09:18 編輯

回復 5# HSIEN6001


    跟我後來弄的公式很像
   感謝

我使用的函數多了點

[attach]15117[/attach]
作者: freeffly    時間: 2013-5-31 09:14

回復 6# Hsieh


    謝謝超版
   這各方法不錯
   沒有用到函數
   
   用google大神也找到以前超版對其他人解的例子有講到EMD
    原來這各是處理民國的方式
   學習了
作者: GBKEE    時間: 2013-5-31 10:26

回復 7# freeffly
  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.         .Cells(1).Select
  8.         For i = 1 To .Count
  9.             xl_Year = Split(.Cells(i), "年")
  10.             xl_Year(0) = xl_Year(0) + 1911 & "年"
  11.             .Cells(i) = Trim(Join(xl_Year, ""))
  12.             DoEvents
  13.             Application.SendKeys "{F2}"
  14.             Application.SendKeys "~"
  15.             DoEvents
  16.         Next
  17.         .Cells(1).Select
  18.         .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
  19.     End With
  20. End Sub
複製代碼
作者: freeffly    時間: 2013-5-31 11:30

回復 10# GBKEE


    超版就是這各
   SendKeys這各還是第一次接觸
   先收下研究一下
作者: ML089    時間: 2013-6-3 19:50

回復 3# freeffly

有規則的資料可以用 MID及FIND函數來完成

B2公式
=--(MID(A2,10,3)+1911&MID(A2,13,FIND("日　",A2)-12))

出來是數字，需設定儲存格格式 - 日期，才會顯示日期
作者: c_c_lai    時間: 2013-6-4 09:25

我想要在B欄顯示A欄對應的西元日期
請問有辦法做到嗎?
freeffly 發表於 2013-5-30 16:07

以下是 GBKEE 版大的綜合版：
  1. Sub Ex()
  2.     Dim i  As Long, xl_Year As String,  yr As String
  3.    
  4.     With Range("A1:A" & [A1].End(xlDown).Row)
  5.         .Cells(1).Select
  6.         For i = 1 To .Count
  7.             If InStr(.Cells(i), "中華民國") Then
  8.                 '  InStr 函數 傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
  9.                 xl_Year = Mid(.Cells(i), InStr(.Cells(i), "中華民國") + 4, 10)      '  年度
  10.                 yr = Trim(Str(Int(Left(xl_Year, InStr(xl_Year, "年") - 1)) + 1911) + Mid(xl_Year, InStr(xl_Year, "年"), InStr(xl_Year, "日") - InStr(xl_Year, "年") + 1))
  11.                 .Cells(i).Offset(, 1) = yr
  12.                 .Cells(i).Offset(, 2) = Left(yr, 4) + "/" + Mid(yr, 6, InStr(yr, "月") - 6) + "/" + Mid(yr, InStr(yr, "月") + 1, InStr(yr, "日") - InStr(yr, "月") - 1)
  13.             End If
  14.         Next i
  15.     End With
  16. End Sub
複製代碼
[attach]15157[/attach]
作者: freeffly    時間: 2013-6-6 11:33

本帖最後由 freeffly 於 2013-6-6 11:41 編輯

回復 12# ML089


    這各夠短，也很好用

   試了一下，對於日期的處理我都是用date的方式
   這種方法我現在學習了
作者: freeffly    時間: 2013-6-6 11:37

回復 13# c_c_lai


    這各方式跑起來花了些時間
   不過一樣有達到效果
作者: ML089    時間: 2013-6-6 12:03

回復 14# freeffly

EXCEL在計算時，很智慧辨識一些文字格式轉化為數值進行計算

XXXX-XX-XX， XXXX/XX/XX， XX/XX， XXXX年XX月XX日 都會視為日期自動換進行計算

XX:XX， XX:XX:XX  都會視為時間自動換進行計算

所以在計算時不見得需要用日期、時間函數還轉煥
.
作者: freeffly    時間: 2013-6-6 13:59

回復 16# ML089


    這我以前倒不知道
   我都東學一點西學一點
   會有遺漏的點
   感謝教導
作者: GBKEE    時間: 2013-6-6 14:48

回復 13# 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.         .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
  16.     End With
  17. End Sub
複製代碼
作者: c_c_lai    時間: 2013-6-6 15:18

回復 18# GBKEE
您應用 Split 與 Replace 的技巧，給我很大的啟示及，幫助、瞭解，
謝謝您！
另外再順帶請教： .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
只 Sort B欄的部分，如果我想要同時能將 A欄一併同時正確地一次完成 Sort，
那如何處理？
作者: c_c_lai    時間: 2013-6-6 16:16

回復 18# GBKEE
我自己摸索，已經找到答案了，謝謝您！
  1. Sub Ex_日期數值()
  2.     Dim i  As Long, xl_Year As Variant
  3.    
  4.     With Range("B1:B" & [A1].End(xlDown).Row)
  5.         .Cells = "=MID(RC[-1],10,10)"
  6.         .Value = .Value
  7.         .Replace "發", ""
  8.         
  9.         For i = 1 To .Count
  10.             xl_Year = Split(.Cells(i), "年")
  11.             xl_Year(0) = xl_Year(0) + 1911 & "年"
  12.             .Cells(i) = Trim(Join(xl_Year, ""))
  13.             .Cells(i).Offset(, 1) = .Cells(i)
  14.         Next
  15.         
  16.         .Cells.Offset(, 1).Replace "年", "/", xlPart
  17.         .Cells.Offset(, 1).Replace "月", "/"
  18.         .Cells.Offset(, 1).Replace "日", ""
  19.         ' .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
  20.     End With
  21.    
  22.     '  With Sheet3
  23.     '      .Range("A1").CurrentRegion.Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlNo
  24.     '  End With
  25.     '  Range("A1").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
  26.     Range("A1").CurrentRegion.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlNo
  27. End Sub
複製代碼
作者: GBKEE    時間: 2013-6-6 17:53

回復 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    時間: 2013-6-6 19:11

回復 21# GBKEE
感謝您的指導，我又學到了 .Offset(, -1).Resize(, 2)
的應用，實在非常實用。再次說聲謝謝！
作者: Hsieh    時間: 2013-6-6 23:37

本帖最後由 Hsieh 於 2013-6-6 23:47 編輯

回復 1# freeffly

[attach]15198[/attach]
  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    時間: 2013-6-7 07:11

本帖最後由 c_c_lai 於 2013-6-7 07:12 編輯
回復  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

  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    時間: 2013-6-7 08:03

回復 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

  11. Function CEDate(DateStr As String)    '  「C.E.」是「Common Era」的縮寫，意為「公元」
  12.     CEDate = CDate(DateStr)
  13. End Function
複製代碼
謝謝兩位版大的鼎力幫忙。
作者: freeffly    時間: 2013-6-17 10:35

回復 23# Hsieh


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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)