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

(Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

ฟอรั่มถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถาม-ตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบ ต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. อธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. ควรแนบตัวอย่างไฟล์มาที่ฟอรั่มนี้เพื่อเพิ่มความสะดวกในการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่น นอกจากนี้ไม่ควรแนบไฟลที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. สำหรับคำถามเกี่ยวกับ VBA ให้ลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน ควรโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. แจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

(Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#1

Postby parakorn » Sun Sep 03, 2017 6:08 pm

เรียนอาจารย์ที่เคารพ และเพื่อนสมาชิกในบอร์ดครับ
เผอิญผมบันทึก Macro การ แปลงไฟล์ จาก .txt มาเป็นไฟล์ Excel แล้วทำการเซพกลับไปที่ โฟลเดอร์เดิมทีละไฟล์
จากโค้ดแนบนี้ อยากขอรบกวน ปรับเป็นการทำงานทีเดียวทุกๆไฟล์ ครับ :D

Code: Select all

Sub Macro1()
' Macro1 Macro
    ChDir "E:\Input"
    Workbooks.OpenText Filename:="E:\Input\incentive_A.txt", Origin:=874, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
        Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
        , 1), Array(4, 2), Array(5, 9), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, _
        1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
        Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 3), Array(22, 4)), _
        TrailingMinusNumbers:=True
    ActiveWorkbook.SaveAs Filename:="E:\Input\incentive_A.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
End Sub
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#2

Postby snasui » Sun Sep 03, 2017 7:22 pm

:D ลองแนบตัวอย่างไฟล์และไฟล์ Excel มาด้วยจะได้สะดวกในการทดสอบครับ

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#3

Postby parakorn » Sun Sep 03, 2017 7:56 pm

เพิ่มเติมไฟล์แนบครับ :D
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#4

Postby snasui » Sun Sep 03, 2017 8:43 pm

:D ตัวอย่าง Code ครับ

Code: Select all

Sub Macro1()
' Macro1 Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String
   
    strPath = Application.GetOpenFilename("Text files(*.txt*),*.txt*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)
        'ChDir "E:\Input"
        fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
        Workbooks.OpenText Filename:=strPath(i), Origin:=874, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
            Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
            , 1), Array(4, 2), Array(5, 9), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, _
            1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
            Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 3), Array(22, 4)), _
            TrailingMinusNumbers:=True
        ActiveWorkbook.SaveAs Filename:=fName, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close False
    Next i
    MsgBox "Finish."
End Sub

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#5

Postby parakorn » Sun Sep 03, 2017 8:57 pm

ขอบพระคุณครับอาจารย์ :D
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#6

Postby parakorn » Mon Sep 11, 2017 12:44 am

เรียนสอบถามเพิ่มเติมครับ
ผมได้ลองปรับโค้ดที่อาจารย์สอน มาใช้กับงานลักษณ์ เลือกไฟล์หลายๆ มาเรียงต่อกัน
โดยขอเพิ่มเงื่อนไข ใส่ชื่อชีทเพิ่มใน คอลัมภ์สุดท้าย ทุกๆบรรทัด เท่าที่มีข้อมูล ก่อน Copy นำมาต่อกันด้วยครับ

ซึ่งโค้ดที่ได้ลองปรับเบื้องต้น ดังนี้ครับ

Code: Select all

Sub Macro1()
' Macro1 Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String
   
    strPath = Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)

        fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
    Application.Goto Reference:="R2C1"
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Cut
    Windows("LetGetFile.xlsx").Activate
    Application.Goto Reference:="R1C1"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
       
    Next i
    MsgBox "Finish."
End Sub


ซึ่งยังไม่ได้ผลตามต้องการครับ จึงขอรบกวนด้วยครับ :flw:
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#7

Postby snasui » Mon Sep 11, 2017 4:34 pm

:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Macro1()
' Macro1 Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String, nb As Workbook
    Dim tb As Workbook
   
    Set tb = ThisWorkbook
    strPath = Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)
        Set nb = Workbooks.Open(strPath(i))
        With nb.Worksheets(1)
            .Range("a2").Offset(0, .UsedRange.Columns.Count) _
                .Resize(.UsedRange.Rows.Count - 1, 1).Value = .Name
            .UsedRange.Offset(1, 0).Copy
        End With
        With tb.Sheets(1)
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
        nb.Close False
    Next i
    MsgBox "Finish."
End Sub

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#8

Postby parakorn » Tue Sep 12, 2017 9:20 am

snasui wrote::D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Macro1()
' Macro1 Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String, nb As Workbook
    Dim tb As Workbook
   
    Set tb = ThisWorkbook
    strPath = Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)
        Set nb = Workbooks.Open(strPath(i))
        With nb.Worksheets(1)
            .Range("a2").Offset(0, .UsedRange.Columns.Count) _
                .Resize(.UsedRange.Rows.Count - 1, 1).Value = .Name
            .UsedRange.Offset(1, 0).Copy
        End With
        With tb.Sheets(1)
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
        nb.Close False
    Next i
    MsgBox "Finish."
End Sub


ขอบคุณมากครับ :shock: :shock: :shock:
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#9

Postby parakorn » Tue Sep 12, 2017 3:58 pm

ขอสอบถามเพิ่มเติมต่อเลยนะครับ
จาก Code ด้านบน ต้องการจับเงื่อนไขเพิ่มเติมดังนี้ครับ
ที่ Sheet Count คือชีทที่วาง Code สำหรับ Import File
ซึ่งหาก ไฟล์ที่ Import มีการ Import ซ้ำ (มีชื่อไฟล์ ใน Column C)
ต้องการเพิ่ม กล่องโต้ตอบ Yes No เพื่อยืนยันว่าจะ Import หรือไม่ โดยต้องการ Check ทุกๆไฟล์ที่เลือกจะ Import ด้วยนะครับ
ซึ่ง Code ที่ลองปรับไม่สามารถใช้งานได้ครับ :?

Code: Select all

Sub ImportManyfileToDatabase()
' ImportManyfileToDatabase Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String, nb As Workbook
    Dim tb As Workbook
   
    Set tb = ThisWorkbook
    strPath = Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    Set C = Column.C: C
    If Find(tb, C, fName) > 0 Then
    MsgBox "This file is already made Are You Continue?", vbYesNo
    If vbYes Then
    For i = 1 To UBound(strPath)
        Set nb = Workbooks.Open(strPath(i))
        With nb.Worksheets(1)
            .Range("a2").Offset(0, .UsedRange.Columns.Count) _
                .Resize(.UsedRange.Rows.Count - 1, 1).Value = .Name
            .UsedRange.Offset(1, 0).Copy
        End With
        With tb.Sheets("Count")
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
        nb.Close False
    Next i
    MsgBox "Finish."

End If
End Sub
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#10

Postby snasui » Tue Sep 12, 2017 8:59 pm

:D การตรวจสอบว่าซ้ำ ตรวจสอบชื่อไฟล์หรือตรวจสอบข้อมูลครับ :?:

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#11

Postby parakorn » Wed Sep 13, 2017 12:45 am

ตรวจชื่อไฟล์ครับ(เข้าใจว่าต้อง นำมา match กับชื่อไฟล์ที่คีย์แล้วคือ column C)
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#12

Postby snasui » Wed Sep 13, 2017 5:23 am

:D ตัวอย่าง Code ครับ

Code: Select all

Sub ExportManyfiletoxlsx()
' ExportManyfiletoxlsx Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String
   
    strPath = Application.GetOpenFilename("Text files(*.txt*),*.txt*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)
        fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
        Workbooks.OpenText Filename:=strPath(i), Origin:=874, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
        Space:=True, Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 1)), _
        TrailingMinusNumbers:=True

        ActiveWorkbook.SaveAs Filename:=fName, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close False
    Next i
    MsgBox "Finish."
End Sub

Sub ImportManyfileToDatabase()
' ImportManyfileToDatabase Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String, nb As Workbook
    Dim tb As Workbook, ans As Integer
   
    Set tb = ThisWorkbook
    strPath = Application.GetOpenFilename("Excel files(*.xlsx*),*.xlsx*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
'    Set C = Column.C: C
'    If Find(tb, C, fName) > 0 Then
'    MsgBox "This File Is Made Are You Continue", vbYesNo
'    If vbYes Then
    For i = 1 To UBound(strPath)
        Set nb = Workbooks.Open(strPath(i))
        With nb.Worksheets(1)
            .Range("a2").Offset(0, .UsedRange.Columns.Count) _
                .Resize(.UsedRange.Rows.Count - 1, 1).Value = .Name
            .UsedRange.Offset(1, 0).Copy
        End With
        With tb.Sheets("Count")
            If Application.CountIf(.Range("c:c"), nb.Name) Then
                ans = MsgBox("This File Is Made Are You Continue.", vbYesNo)
                If ans = vbYes Then
                    .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Else
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End If
        End With
        Application.CutCopyMode = False
        nb.Close False
    Next i
    MsgBox "Finish."

'End If
End Sub

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#13

Postby parakorn » Wed Sep 13, 2017 11:31 am

ลองปรับแล้ว ยังสามารถ Import ไฟล์เดิมได้ครับผม :tt:
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#14

Postby snasui » Wed Sep 13, 2017 6:20 pm

:D ปรับบรรทัด If ที่ใช้เช็คชื่อไฟล์เป็นด้านล่างครับ

If Application.CountIf(.Range("c:c"), VBA.Left(nb.Name, InStrRev(nb.Name, ".") - 1)) Then

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#15

Postby parakorn » Thu Sep 14, 2017 9:44 am

snasui wrote::D ปรับบรรทัด If ที่ใช้เช็คชื่อไฟล์เป็นด้านล่างครับ

If Application.CountIf(.Range("c:c"), VBA.Left(nb.Name, InStrRev(nb.Name, ".") - 1)) Then


Complete แล้วครับ :cp:
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#16

Postby parakorn » Sat Sep 16, 2017 5:12 pm

snasui wrote::D ตัวอย่าง Code ครับ

Code: Select all

Sub Macro1()
' Macro1 Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String
   
    strPath = Application.GetOpenFilename("Text files(*.txt*),*.txt*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)
        'ChDir "E:\Input"
        fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
        Workbooks.OpenText Filename:=strPath(i), Origin:=874, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
            Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
            , 1), Array(4, 2), Array(5, 9), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, _
            1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
            Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 3), Array(22, 4)), _
            TrailingMinusNumbers:=True
        ActiveWorkbook.SaveAs Filename:=fName, FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close False
    Next i
    MsgBox "Finish."
End Sub


ขอย้อนกลับมาพัฒนาโค้ดนี้ต่อนะครับ ผมต้องการ นำข้อมูลชีทที่ชื่อไฟล์ ไม่ได้ต่อท้ายด้วย A (คือ B,C,D,E เรียงตามลำดับ) Copy มาวางที่ ไฟล์ที่มีชื่อต่อท้ายด้วย A แล้วให้ทำการ เปลี่ยนชื่อชีทแลพ ชื่อไฟล์ โดยลบ _A ออกไป(รวมถึงชื่อไฟล์ด้วยครับ) แล้วเซพ

เช่น Incentive_A , Incentive_B ข้อมูล ไฟล์ Incentive_B(C,D,E.....) ให้ Copy ไปต่อท้าย Incentive_A
แล้วแก้ไขชื่อไฟล์ และ ชื่อชีท จาก Incentive_A เป็น Incentive
แล้วเซพ

แล้วเริ่มทำงานกับ ชุด Incentive2_A , B ต่อไปในลักษณะเดิมครับ :D

Code: Select all

Sub Macro1()
' Macro1 Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String
   
    strPath = Application.GetOpenFilename("Text files(*.txt*),*.txt*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)
        'ChDir "E:\Input"
        fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
        Workbooks.OpenText Filename:=strPath(i), Origin:=874, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
            Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
            , 1), Array(4, 2), Array(5, 9), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, _
            1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
            Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 3), Array(22, 4)), _
            TrailingMinusNumbers:=True
   
    Windows("incentive_B.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,1,,COUNTA(C1),COUNTA(R2))"
    Selection.Copy
    Windows("incentive_A.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1)+1,,,)"
    ActiveSheet.Paste
    Sheets("incentive_A").Name = "incentive"
   
        'ActiveWorkbook.SaveAs Filename:=fName, FileFormat:= _
            'xlOpenXMLWorkbook, CreateBackup:=False
        'ActiveWorkbook.Close False
   
    Next i
    MsgBox "Finish."
End Sub
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#17

Postby snasui » Sat Sep 16, 2017 7:15 pm

:D แนบไฟล์โปรแกรมล่าสุดมาด้วยจะได้เขียนต่อไปจากนั้นครับ

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#18

Postby parakorn » Sat Sep 16, 2017 8:59 pm

ไฟล์แนบครับ :D
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น

User avatar
snasui
Site Admin
Site Admin
Posts: 21977
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#19

Postby snasui » Sat Sep 16, 2017 11:43 pm

parakorn wrote:ต้องการ นำข้อมูลชีทที่ชื่อไฟล์ ไม่ได้ต่อท้ายด้วย A (คือ B,C,D,E เรียงตามลำดับ) Copy มาวางที่ ไฟล์ที่มีชื่อต่อท้ายด้วย A แล้วให้ทำการ เปลี่ยนชื่อชีทแลพ ชื่อไฟล์ โดยลบ _A ออกไป(รวมถึงชื่อไฟล์ด้วยครับ) แล้วเซพ


:D อ่านแล้วยังไม่กระจ่างครับ เนื่องจากไม่พบไฟล์ที่ไม่มีต่อท้ายด้วยอักขระ A, B ไฟล์ที่ Zip มามี 4 ไฟล์คือ incentive_A.txt, incentive2_A.txt, incentive_ฺB.txt และ incentive2_B.txt

จากไฟล์ดังกล่าว ช่วยลำดับการทำงานมาอีกครั้งเพื่อจะได้เข้าใจตรงกันครับ

User avatar
parakorn
Silver
Silver
Posts: 669
Joined: Thu Mar 14, 2013 9:41 am
Contact:

Re: (Macro VBA)ต้องการดึงไฟล์มาทีละหลายๆไฟล์ นำมาแปลงไฟล์ครับ

#20

Postby parakorn » Thu Sep 21, 2017 10:09 am

แนบไฟล์มาใหม่ครับผม :D

Code: Select all

Sub Macro1()
' Macro1 Macro
    Dim strPath As Variant, i As Integer
    Dim fName As String
   
    strPath = Application.GetOpenFilename("Text files(*.txt*),*.txt*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub
   
    For i = 1 To UBound(strPath)

        fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
        Workbooks.OpenText Filename:=strPath(i), Origin:=874, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
            Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
            , 1), Array(4, 2), Array(5, 9), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, _
            1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
            Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 3), Array(22, 4)), _
            TrailingMinusNumbers:=True
           
        Next i

    Windows("incentive_B.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,1,,COUNTA(C1)-1,COUNTA(R2))"
    Selection.Copy
    Windows("incentive_A.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1)+1,,,)"
    ActiveSheet.Paste
        Windows("incentive_C.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,1,,COUNTA(C1)-1,COUNTA(R2))"
    Selection.Copy
    Windows("incentive_A.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1)+1,,,)"
    ActiveSheet.Paste
        Windows("incentive_D.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,1,,COUNTA(C1)-1,COUNTA(R2))"
    Selection.Copy
    Windows("incentive_A.txt").Activate
    Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1)+1,,,)"
    ActiveSheet.Paste
    Sheets("incentive_A").Name = "incentive"
   
        'ActiveWorkbook.SaveAs Filename:=fName, FileFormat:= _
            'xlOpenXMLWorkbook, CreateBackup:=False
        'ActiveWorkbook.Close False
   
    MsgBox "Finish."
End Sub
You do not have the required permissions to view the files attached to this post.
"," คือ ยูเนี่ยน ใช้เลือกช่วงใดบ้างให้คำนวณทั้งหมด(เลือกซ้ำคำนวณซ้ำ)
":" คือ เซต ใช้สร้างช่วงตารางข้อมูลระหว่าง2Cell
" "(เว้นวรรค) คือ อินเตอร์เซก ใช้สร้างเซตระหว่างจุดตัดเซตทั้งหมดที่ทับกัน

Array ต้องเป็น เซตเท่านั้น


Return to “Excel”

Who is online

Users browsing this forum: Google Feedfetcher, Google [Bot] and 35 guests