:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่

Post a reply


This question is a means of preventing automated form submissions by spambots.
Smilies
:D :thup: :cp: :flw: :rz: :sg: :tt: :) ;) :( :o :shock: :? 8-) :lol: :x :P :oops: :cry: :evil: :twisted: :roll: :!: :?: :idea: :arrow: :ard: :arl: :aru: :| :mrgreen: :geek: :ugeek:

BBCode is ON
[img] is ON
[url] is ON
Smilies are ON

Topic review
   

Expand view Topic review: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#11

by bank9597 » Thu Aug 27, 2015 2:21 pm

คุณต้องเขียนโค๊ดแยกออกจากกันครับ คือจะ Import กี่ไฟล์ ก็ต้องสร้างโค๊ดเท่านั้น เว้นแต่คุณจะใช้การ Loop

คุณสามารถปรับ public sub new_import ได้ ตามจำนวนไฟล์ที่ต้องการ import ครับ

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#10

by piches » Thu Aug 27, 2015 2:10 pm

ขอโทษครับคุณ Bank9597
ถ้าจะ QueryTables ไฟล์ scb_in.txt ไปที่ sheet (inscb)
ไฟล์ scb_Out.txt ไปที่ sheet (Outscb)
ไฟล์ ks_in.txt ไปที่ sheet (inks)
ไฟล์ ks_Out.txt ไปที่ sheet (Outks)
ผมทดรองเขียน Code ต่อกัน จะขึ้นว่า ช่วงปลายทางไม่ได้อยู่ใน worksheets เดียวกันกับ worksheets ที่ตรารางQueryถูกสร้างขึ้นครับคุณ Bank9597

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#9

by bank9597 » Thu Aug 27, 2015 11:48 am

ผมชื่อ Bank9597 ครับ :)

ลองใส่

Code: Select all

.TextFilePlatform = 874
ลงในโค๊ดครับ

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"
        .TextFilePlatform = 874
        .TextFileColumnDataTypes = Array(1, 2, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        End With
        
        With Sheets("INSCB")
            Rows("1:5").Delete Shift:=xlUp
        End With
End Sub

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#8

by piches » Thu Aug 27, 2015 11:14 am

ขอบคุณครับ Joined วันที่ออกมาถูกต้องแล้วครับแต่ ข้อความกายเป็นภาษาญี่ปุ่นแทนต้องแก้ยังไงครับคุณ Joined コテヤノムキ ヘヤケソヤケヤキ ヘユ倏遉キテヤ、 ィモ。ムエ

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#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

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#5

by snasui » Tue Aug 25, 2015 8:08 pm

piches wrote:formats Short date: dd/MM/yyyy
:D หากคีย์สูตร

=Today()

ในสมุดงานใหม่ ในเซลล์ใด ๆ ได้ Format เป็นแบบใดครับ dd/mm/yyyy หรือ mm/dd/yyyy ครับ

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#4

by piches » Tue Aug 25, 2015 12:00 pm

เป็นทุกไฟล์ ครับ ตั้งแต่วันที่1-12 แต่หลังจากวันที่ 12 จะไม่เป็นครับ formats Short date: dd/MM/yyyy ครับผม ถ้า Coppyแล้วไปวางได้ปกติ
ไม่สลับกันแต่พอใช้ VBA Coppy มาวางวันที่จะสลับกับเดือนครับ

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#3

by jelelite » Tue Aug 25, 2015 11:19 am

เป็นทุกไฟล์รึเปล่าครับ ถ้าเป็นทุกไฟล์ลองไปตั้งค่า windows ที่ Region and Language setting แล้วดูว่า รูปแบบ วันที่ เป็น dd/mm/yy รึเปล่า ถ้าไม่ใช่ก็เปลี่ยนให้เป็น dd/mm/yy ดูนะครับ

Re: คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#2

by bank9597 » Mon Aug 24, 2015 6:34 pm

ลองใช้การบันทึกมาโคร แล้วทำการ Import ข้อมูลเข้ามาครับ ปรับคอลัมน์ที่เป็นวันที่ให้กลายเป็น Text เช่น

Code: Select all

    ActiveWindow.SmallScroll Down:=-9
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\bank9597\Downloads\scb.txt", Destination:=Range("$A$1"))
        .Name = "scb"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1,2, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

Code: Select all

.TextFileColumnDataTypes = Array(1,2, 1, 1, 1, 1, 1, 1, 1)
เลข 2 ในโค๊ด คือส่วนที่แปลงวันที่ให้เป็น Text

คัดลอกข้อมูลจากไฟล์ text มาไว้ใน worksheets วันที่กับเดือนสลับกัน

#1

by piches » Mon Aug 24, 2015 5:37 pm

Code: Select all

Sub createPivotTable1()
Dim wb As Variant, Source As Range
On Error Resume Next
'ดึงข้อมูลไฟล์ Text ชื่อ scb-รับ.txt
ThisWorkbook.Activate
Sheets("INKS").Select
Range("A1:H65536").ClearContents
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(3).Activate
Range("a65536").End(xlUp).Offset(0, 0).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
 Windows("scb.txt").Activate
ActiveWindow.Close False
'ดึงข้อมูลไฟล์ 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
ต้องแก้ยังไงครับอาจารย์ขอคำแนาะนำด้วยครับ ขอบคุณครับ
Attachments
สมุดงาน1 - Copy.xlsm
(67.12 KiB) Downloaded 15 times
Clash 4.rar
(5.31 KiB) Downloaded 18 times

Top