donod

帖子: 140
主題: 24
精華: 0
積分: 167
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-2-26
最後登錄: 2023-1-30

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2013-4-8 12:36 | 只看該作者

[發問] 如何分開日期和時間

test A.rar (14.51 KB)
請問如何改寫，才可得到以下結果:

test5.rar (7.14 KB)
謝謝!

樓主熱帖

donod

中學生 Rank: 2

帖子: 140
主題: 24
精華: 0
積分: 167
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-2-26
最後登錄: 2023-1-30

2^#

發表於 2013-4-8 12:50 | 只看該作者

漏了來源.TXT檔案，現補上來源.TXT檔案

test5.rar (245 Bytes) 來源.TXT檔案

test A.rar (14.51 KB) VBA檔案
請問如何改寫，才可得到以下結果:

test5a.rar (7.14 KB) 想要的檔案

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 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

複製代碼

學海無涯_不恥下問

TOP

donod

中學生 Rank: 2

帖子: 140
主題: 24
精華: 0
積分: 167
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-2-26
最後登錄: 2023-1-30

4^#

發表於 2013-4-8 15:19 | 只看該作者

回復 3# Hsieh
仍然不成功

test A1.rar (13.22 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

5^#

發表於 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

複製代碼

學海無涯_不恥下問

TOP

donod

中學生 Rank: 2

帖子: 140
主題: 24
精華: 0
積分: 167
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-2-26
最後登錄: 2023-1-30

6^#

發表於 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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2013-4-8 16:31 | 只看該作者

回復 6# donod

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

學海無涯_不恥下問

TOP

donod

中學生 Rank: 2

帖子: 140
主題: 24
精華: 0
積分: 167
點名: 0
作業系統: WIN 7
軟體版本: OFFICE 2007
閱讀權限: 20
性別: 男
註冊時間: 2012-2-26
最後登錄: 2023-1-30

8^#

發表於 2013-4-8 18:13 | 只看該作者

回復 7# Hsieh
是否這樣做?

Book1.rar (10.38 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-21

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

9^#

發表於 2013-4-8 18:25 | 只看該作者