#7
by bank9597 » Thu Aug 27, 2015 10:39 am
การ Import ลักษณะนี้
Code: Select all
Workbooks.Open Filename:="C:\Users\Cz410036\Desktop\Clash 4\scb.txt"
คุณจะไม่สามารถกำหนดฟอร์แมตให้เป็นไปในแบบที่ต้องการได้ จะเห็นได้ว่า บางเซลล์ฟอร์แมตถูกต้อง บางเซลล์ฟอร์แมตผิดเพี้ยน
ถ้าทำตามที่ผมเสนอแนะ คือ ให้ลองบันทึกมาโครตอนที่เราทำการ Import text file เข้ามา โดยปรับคอลัมน์วันที่ให้เป็น Text ก่อน
เราจะได้ข้อมูลที่มีฟอร์แมตไม่ผิดเพี้ยน แต่จะถูดจัดเก็บในรูปแบบ Text ซึ่งเวลานำมาใช้ เราสามารถแปลงให้อยู่ในรูปแบบที่ถูกต้องได้ หรือไม่ก็เขียนโค๊ดแปลงทั้งคอลัมน์ก็ได้เช่นกัน
ลองใช้โค๊ดนี้ Import ดูครับ
Code: Select all
Public Sub new_import()
With Sheets("INSCB").QueryTables.Add(Connection:= _
"TEXT;C:\Users\bank9597\Downloads\scb_in.txt", Destination:=Range("$A$1"))
.Name = "scb_in"
.TextFileColumnDataTypes = Array(1, 2, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With Sheets("INSCB")
Rows("1:5").Delete Shift:=xlUp
End With
End Sub
เปลี่ยนที่อยู่ไฟล์ใหม่
Code: Select all
C:\Users\bank9597\Downloads\scb_in.txt
แล้วนำมาใช้ในโค๊ดของคุณดังนี้
Code: Select all
Sub createPivotTable1()
Dim wb As Variant, Source As Range
On Error Resume Next
'´Ö§¢éÍÁÙÅä¿Åì Text ª×èÍ scb-ÃѺ.txt
Call new_import
'´Ö§¢éÍÁÙÅä¿Åì Text ª×èÍ scb-¨èÒÂ.txt
Workbooks.Open Filename:="C:\Users\Cz410036\Desktop\Clash 4\scb-¨èÒÂ.txt"
Application.ScreenUpdating = False
Range("A5:H" & Range("a65536").End(xlUp).Row).Copy
ThisWorkbook.Sheets(4).Activate
Range("a65536").End(xlUp).Offset(0, 0).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Windows("scb-¨èÒÂ.txt").Activate
ActiveWindow.Close False
'-----------------------------------------------------------------
'¤ÓÊÑè§·ÓPivotTable scb-ÃѺ
Dim PvtTbl As PivotTable
Dim wsData As Worksheet
Dim rngData As Range
Dim PvtTblCache As PivotCache
Set wsData = Worksheets("INSCB")
Set wsPvtTbl = Worksheets("ÃѺSCB")
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl
Set rngData = wsData.Range("A1:G400")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
PvtTbl.ManualUpdate = True
Set pvtFld = PvtTbl.PivotFields("Çѹ¤Ãº¡Ó˹´")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("ÅÙ¡¤éÒ")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
pvtFld.Orientation = xlValuesField
With PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 1
End With
PvtTbl.ManualUpdate = False
'---------------------------------------------------------------------------
'¤ÓÊÑè§·ÓPivotTable scb-¨èÒÂ
Set wsData = Worksheets("OUTSCB")
Set wsPvtTbl = Worksheets("¨èÒÂSCB")
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl
Set rngData = wsData.Range("A1:G400")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
PvtTbl.ManualUpdate = True
Set pvtFld = PvtTbl.PivotFields("Çѹ¤Ãº¡Ó˹´")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("à¨éÒ˹Õé")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
pvtFld.Orientation = xlValuesField
With PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 1
End With
PvtTbl.ManualUpdate = False
End Sub
การ Import ลักษณะนี้ [code]Workbooks.Open Filename:="C:\Users\Cz410036\Desktop\Clash 4\scb.txt"[/code] คุณจะไม่สามารถกำหนดฟอร์แมตให้เป็นไปในแบบที่ต้องการได้ จะเห็นได้ว่า บางเซลล์ฟอร์แมตถูกต้อง บางเซลล์ฟอร์แมตผิดเพี้ยน
ถ้าทำตามที่ผมเสนอแนะ คือ ให้ลองบันทึกมาโครตอนที่เราทำการ Import text file เข้ามา โดยปรับคอลัมน์วันที่ให้เป็น Text ก่อน
เราจะได้ข้อมูลที่มีฟอร์แมตไม่ผิดเพี้ยน แต่จะถูดจัดเก็บในรูปแบบ Text ซึ่งเวลานำมาใช้ เราสามารถแปลงให้อยู่ในรูปแบบที่ถูกต้องได้ หรือไม่ก็เขียนโค๊ดแปลงทั้งคอลัมน์ก็ได้เช่นกัน
ลองใช้โค๊ดนี้ Import ดูครับ
[code]Public Sub new_import()
With Sheets("INSCB").QueryTables.Add(Connection:= _
"TEXT;C:\Users\bank9597\Downloads\scb_in.txt", Destination:=Range("$A$1"))
.Name = "scb_in"
.TextFileColumnDataTypes = Array(1, 2, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With Sheets("INSCB")
Rows("1:5").Delete Shift:=xlUp
End With
End Sub[/code]
เปลี่ยนที่อยู่ไฟล์ใหม่ [code]C:\Users\bank9597\Downloads\scb_in.txt[/code]
แล้วนำมาใช้ในโค๊ดของคุณดังนี้
[code]Sub createPivotTable1()
Dim wb As Variant, Source As Range
On Error Resume Next
'´Ö§¢éÍÁÙÅä¿Åì Text ª×èÍ scb-ÃѺ.txt
Call new_import
'´Ö§¢éÍÁÙÅä¿Åì Text ª×èÍ scb-¨èÒÂ.txt
Workbooks.Open Filename:="C:\Users\Cz410036\Desktop\Clash 4\scb-¨èÒÂ.txt"
Application.ScreenUpdating = False
Range("A5:H" & Range("a65536").End(xlUp).Row).Copy
ThisWorkbook.Sheets(4).Activate
Range("a65536").End(xlUp).Offset(0, 0).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Windows("scb-¨èÒÂ.txt").Activate
ActiveWindow.Close False
'-----------------------------------------------------------------
'¤ÓÊÑè§·ÓPivotTable scb-ÃѺ
Dim PvtTbl As PivotTable
Dim wsData As Worksheet
Dim rngData As Range
Dim PvtTblCache As PivotCache
Set wsData = Worksheets("INSCB")
Set wsPvtTbl = Worksheets("ÃѺSCB")
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl
Set rngData = wsData.Range("A1:G400")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
PvtTbl.ManualUpdate = True
Set pvtFld = PvtTbl.PivotFields("Çѹ¤Ãº¡Ó˹´")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("ÅÙ¡¤éÒ")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
pvtFld.Orientation = xlValuesField
With PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 1
End With
PvtTbl.ManualUpdate = False
'---------------------------------------------------------------------------
'¤ÓÊÑè§·ÓPivotTable scb-¨èÒÂ
Set wsData = Worksheets("OUTSCB")
Set wsPvtTbl = Worksheets("¨èÒÂSCB")
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl
Set rngData = wsData.Range("A1:G400")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=wsPvtTbl.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
PvtTbl.ManualUpdate = True
Set pvtFld = PvtTbl.PivotFields("Çѹ¤Ãº¡Ó˹´")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("à¨éÒ˹Õé")
pvtFld.Orientation = xlRowField
Set pvtFld = PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
pvtFld.Orientation = xlValuesField
With PvtTbl.PivotFields("ÁÙŤèÒàªç¤")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Position = 1
End With
PvtTbl.ManualUpdate = False
End Sub[/code]