麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 如何分開日期和時間 [打印本頁]

作者: donod 時間: 2013-4-8 12:36 標題: 如何分開日期和時間

[attach]14577[/attach]
請問如何改寫，才可得到以下結果:
[attach]14578[/attach]
謝謝!

作者: donod 時間: 2013-4-8 12:50

漏了來源.TXT檔案，現補上來源.TXT檔案
[attach]14579[/attach] 來源.TXT檔案
[attach]14580[/attach] VBA檔案
請問如何改寫，才可得到以下結果:

[attach]14581[/attach]想要的檔案

作者: Hsieh 時間: 2013-4-8 14:24

回復 2# donod

Sub input_txt()
Dim Ay()
fs = ThisWorkbook.Path & "\test5.txt" 'TXT檔名目錄
ar = Array(";", ":", ":")
Open fs For Input As #1
Do While Not EOF(1)
Line Input #1, mystr
For i = 0 To 2
Replace
mystr = Application.Substitute(mystr, "/", ar(i), 3) '取代分隔符號
Next
ReDim Preserve Ay(s)
Ay(s) = mystr
s = s + 1
Loop
Close #1
fs = ThisWorkbook.Path & "\test5.xlsx" '寫入目標檔案目錄
With Workbooks.Open(fs)
.Sheets(1).[A1].CurrentRegion.Clear '清除原資料
.Sheets(1).[A1].Resize(s, 1) = Application.Transpose(Ay) '寫入資料
With .Sheets(1).Columns("A:A") '資料剖析
.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True
.NumberFormatLocal = "m/d/yyyy" '變更日期格式
End With
End With
End Sub

複製代碼

作者: donod 時間: 2013-4-8 15:19

回復 3# Hsieh
仍然不成功
[attach]14582[/attach]

作者: Hsieh 時間: 2013-4-8 16:08

回復 4# donod
資料剖析指名引數不能忽略

Sub input_txt()
Dim Ay()
fs = ThisWorkbook.Path & "\test5.txt" 'TXT檔名目錄
ar = Array(";", ":", ":")
Open fs For Input As #1
Do While Not EOF(1)
Line Input #1, mystr
For i = 0 To 2
mystr = Application.Substitute(mystr, "/", ar(i), 3) '取代分隔符號
Next
ReDim Preserve Ay(s)
Ay(s) = mystr
s = s + 1
Loop
Close #1
fs = ThisWorkbook.Path & "\test5.xlsx" '寫入目標檔案目錄
With Workbooks.Open(fs)
With .Sheets(1)
.[A1].CurrentRegion.Clear '清除原資料
.[A1].Resize(s, 1) = Application.Transpose(Ay) '寫入資料
'資料剖析
.Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
.[A:A].NumberFormatLocal = "m/d/yyyy" '變更日期格式
End With
End With
End Sub

複製代碼

作者: donod 時間: 2013-4-8 16:21

回復 5# Hsieh
請問以下應該要怎樣修改:
'資料剖析

.Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _

      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

      Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _

      :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _

      Array(7, 1)), TrailingMinusNumbers:=True

作者: Hsieh 時間: 2013-4-8 16:31

回復 6# donod

你錄製一個A欄以分號為分隔符號的巨集看看便知

作者: donod 時間: 2013-4-8 18:13

回復 7# Hsieh
是否這樣做?
[attach]14585[/attach]

作者: Hsieh 時間: 2013-4-8 18:25

回復 8# donod

[attach]14586[/attach]

作者: donod 時間: 2013-4-8 20:15

回復 9# Hsieh
請問錯在那裡
[attach]14590[/attach]

作者: luke 時間: 2013-4-8 20:42

回復 10# donod
這兩句有"D:"是錯誤
fs = ThisWorkbook.Path & "D:\test5.txt" 'TXT檔名目錄
fs = ThisWorkbook.Path & "D:\test5.xlsx" '寫入目標檔案目錄

改成
fs = ThisWorkbook.Path & "\test5.txt" 'TXT檔名目錄
fs = ThisWorkbook.Path & "\test5.xlsx" '寫入目標檔案目錄

作者: Hsieh 時間: 2013-4-8 21:49

回復 10# donod

錯在哪裡?
1.你這個檔如果是已經存檔
ThisWorkbook.Path已經會傳回你這個檔案的資料夾位置
fs = ThisWorkbook.Path & "D:\test5.xlsx"
這樣fs就已經不是"D:\test5.xlsx"了
Workbooks.Open就會產生找不到檔案的錯誤
2.你把程式碼寫在工作表模組內，而With Sheets(1)敘述區段內
沒有加上.(句號)就會指向程式所在工作表內的儲存格
      .Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
      Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
      :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
      Array(7, 1)), TrailingMinusNumbers:=True
只差在紅色的點Destination:=.Range("A1")

作者: donod 時間: 2013-4-8 22:29

本帖最後由 donod 於 2013-4-8 22:32 編輯

回復 11# luke
回復 12# Hsieh
如果來源檔案test5.txt是在D:\
想用另外一個VBA檔案將test5.txt轉換成想要的格式檔test5a.xlsx，如何寫?謝謝!

作者: donod 時間: 2013-4-8 22:51

回復 luke
回復 Hsieh
如果來源檔案test5.txt是在D:\
想用另外一個VBA檔案將test5.txt轉換成想要的格式檔test5a.xlsx，如何寫?謝謝!
donod 發表於 2013-4-8 22:29

大大可在2#中找到相關檔案

作者: donod 時間: 2013-4-9 00:16

現在只差A欄的日期和時間未能分開，請大大指教如何改寫。謝謝!
[attach]14594[/attach]來源檔
[attach]14595[/attach]VBA檔
[attach]14596[/attach]想要的結果

作者: luke 時間: 2013-4-9 19:14

回復 15# donod

檔目錄可去除ThisWorkbook.Path 如下
fs = "D:\test5.txt" 'TXT檔名目錄
fs = "d:\test5.xlsx" '寫入目標檔案目錄

另日期"m/d/yyy"格式要改成 "yyyy/m/d" 如下

.[A:A].NumberFormatLocal = "yyyy/m/d" '變更日期格式

作者: GBKEE 時間: 2013-4-13 17:34

回復 15# donod

Sub Ex()
Dim E As Range, W As String
Workbooks.OpenText Filename:="D:\test5.txt"
With ActiveWorkbook.Sheets(1)
.Cells.Replace ";", " ", xlPart
.Columns(2).Insert
For Each E In .Range("A:A").SpecialCells(xlCellTypeConstants)
W = E
E = Mid(W, 1, 10)
E.NumberFormatLocal = "m/d/yyyy;@"
E.Offset(, 1) = Replace(Mid(W, 12), "/", ":")
Next
End With
End Sub

複製代碼

作者: donod 時間: 2013-4-13 23:44

回復 17# GBKEE

版大真的知小輩，正是這個!謝謝GBKEE版大!

作者: donod 時間: 2013-4-14 10:55

回復 17# GBKEE

2013/04/02/09/21/00; 22159; 22159; 22131; 22131; 330
2013/04/02/09/22/00; 22133; 22140; 22130; 22140; 153
2013/04/02/09/23/01; 22140; 22148; 22134; 22139; 109
請問在匯入源檔案時，不匯入屬於時間中的秒值(紅色數字)，可以怎麼寫，再次謝謝版大!

作者: GBKEE 時間: 2013-4-14 14:49

回復 19# donod

'E.Offset(, 1) = Replace(Mid(W, 12), "/", ":")
E.Offset(, 1) = Replace(Mid(W, 12, 5), "/", ":")
'W這字串從第12個字元起取5個字元

複製代碼

作者: donod 時間: 2013-4-14 23:08

回復 donod
GBKEE 發表於 2013-4-14 14:49

謝謝版大!
以下是小輩之後試的:
.Cells.Replace "/01;", " ", xlPart '用空格代替 "/01;" 作為delete秒值
.Cells.Replace ";", " ", xlPart

如果在 .Cells.Replace ";", " ", xlPart 之前加入.Cells.Replace "/01;", " ", xlPart ，雖然結果與版大的一樣，在運作上實則有什麼分別，謝謝!

作者: GBKEE 時間: 2013-4-15 16:52

回復 21# donod
請問 text5的字串,可是全為2013/04/02/09/14/01;
如有 2013/04/02/09/15/00; 2013/04/02/09/15/02; 2013/04/02/09/15/03;
是否要一一去
.Cells.Replace "/00;", " ", xlPart
.Cells.Replace "/02;", " ", xlPart
.Cells.Replace "/03;", " ", xlPart

作者: donod 時間: 2013-4-15 17:56

回復 donod
請問 text5的字串,可是全為2013/04/02/09/14/01;
如有 2013/04/02/09/15/00; 2013/04/02/09 ...
GBKEE 發表於 2013-4-15 16:52

版大一語道破，小輩忽略了這點!用版大的 E.Offset(, 1) = Replace(Mid(W, 12, 5), "/", ":") 就不需要理會秒值是否存在有/00或/01以外的組合。明白了，謝謝!
另外，如果是不匯入2013/04/02/09/14/01;中的某個(e.g.2013/04/02/09/14/01;)或某幾個字元(e.g.2013/04/02/09/14/01;)，當然是全部字串中的相同位，那如何修改，再謝謝版大!

作者: GBKEE 時間: 2013-4-15 19:01

如果是不匯入2013/04/02/09/14/01;中的某個(e.g.2013/04/02/09/14/01;)或某幾個字元(e.g.2013/04/02/09/14/01;)，donod 發表於 2013/4/15 17:56

不解你的意思,請再詳細說明

作者: donod 時間: 2013-4-15 23:59

回復 24# GBKEE

1)不匯入一組字元
2013/04/02/09/21/00; 22159; 22159; 22131; 22131; 330
2013/04/02/09/22/00; 22133; 22140; 22130; 22140; 153
2013/04/02/09/23/01; 22140; 22148; 22134; 22139; 109

2) 不匯入兩組字元
2013/04/02/09/21/00; 22159; 22159; 22131; 22131; 330
2013/04/02/09/22/00; 22133; 22140; 22130; 22140; 153
2013/04/02/09/23/01; 22140; 22148; 22134; 22139; 109

以上兩個個別情況那如何修改，謝謝!

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