: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

ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
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. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#1

Post by aapichaya »

ต้องการimport ข้อมูลจากโฟลเดอร์ที่เราเลือก โดยให้ข้อมูลแสดงในSheet1 ให้ข้อมูลที่importมา จัดเก็บในชีทเดิมต่อจากแถวสุดท้าย และนำข้อมูลทั้งหมดไปประมวลผลต่อไป จากที่ศึกษาเป็นการcopy worksheet ที่เพิ่มขึ้นมา before กับ after sheet ช่วยให้คำแนะนำหน่อยค่ะ

Code: Select all

Sub ImportSheet()
    Dim sImportFile As String, sFile As String
    Dim sThisBk As Workbook
    Dim vfilename As Variant
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set sThisBk = ActiveWorkbook
    sImportFile = Application.GetOpenFilename( _
    FileFilter:="All Excel Files, *.xls; *.xlsx;*.xlsm;*.csv", Title:="Open Workbook")
    If sImportFile = "False" Then
        MsgBox "No File Selected!"
        Exit Sub
         
    Else
        vfilename = Split(sImportFile, "\")
        sFile = vfilename(UBound(vfilename))
        Application.Workbooks.Open Filename:=sImportFile
         
        Set wbBk = Workbooks(sFile)
        With wbBk
            If SheetExists("Raw_Data") Then
                Set wsSht = .Sheets("Raw_Data")
                wsSht.Copy before:=sThisBk.Sheets("Sheet1")
            Else
                MsgBox "There is no sheet with name :Raw_Data in:" & vbCr & .Name
            End If
            wbBk.Close SaveChanges:=False
        End With
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(sWSName)
    If Not ws Is Nothing Then SheetExists = True
End Function

You do not have the required permissions to view the files attached to this post.
User avatar
puriwutpokin
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#2

Post by puriwutpokin »

ควรแนบไฟล์ที่จะ import เป็นตัวอย่างด้วยครับ เบื้องต้นลองศึกษาจาก นี้ครับ
http://www.snasui.com/viewtopic.php?f=3 ... ort#p72907
ติดตรงไหนมาถามกันในนี้ต่อครับ
:shock: :roll: :D
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#3

Post by snasui »

:D ศึกษาได้จาก Video ด้านล่างนี้ ลองปรับ Code มาเองก่อน ติดตรงไหนค่อยนำมาถามกันต่อครับ

aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#4

Post by aapichaya »

puriwutpokin wrote:ควรแนบไฟล์ที่จะ import เป็นตัวอย่างด้วยครับ เบื้องต้นลองศึกษาจาก นี้ครับ
http://www.snasui.com/viewtopic.php?f=3 ... ort#p72907
ติดตรงไหนมาถามกันในนี้ต่อครับ
ขอบคุณมากค่ะ :D
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#5

Post by aapichaya »

snasui wrote::D ศึกษาได้จาก Video ด้านล่างนี้ ลองปรับ Code มาเองก่อน ติดตรงไหนค่อยนำมาถามกันต่อครับ

ขอบคุณมากค่ะ :D .
ถ้าเราต้องการเก็บไฟล์ไปเรื่อยๆ เราสามารถลบบรรทัดที่ clear content ออกได้ไหมคะ

Code: Select all

Sub collectData()
    Dim wb As Workbook, s As Worksheet, db As Worksheet
    Dim StrPath As Variant, i As Integer, f As Byte
        StrPath = Application.GetOpenFilename(FileFilter:="All Excel Files, *.xls; *.xlsx;*.xlsm;*.csv", _
         MultiSelect:=True)
         If TypeName(StrPath) = "Boolean" Then Exit Sub
         Set db = ThisWorkbook.Sheets(1)
        
   'db.UsedRange.ClearContents
          Application.ScreenUpdating = False
            For i = 1 To UBound(StrPath)
                Set wb = Workbooks.Open(StrPath(1))
                For Each s In wb.Worksheets
                f = IIf(db.Range("a1").Value = "", 0, 1)
                If s.Range("a1").Value <> "" Then
                s.UsedRange.Offset(f, 0).Copy
                With db
                .Range("a" & .Rows.Count).End(xlUp).Offset(f, 0) _
                        .PasteSpecial xlPasteValues
                        End With
                        End If
                                     
                Next s
                wb.Close False
                Application.ScreenUpdating = False
                 Next i
          Application.ScreenUpdating = True
          MsgBox "Finished.", vbInformation
          
End Sub
User avatar
puriwutpokin
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#6

Post by puriwutpokin »

ตามโค้ดถ้าไม่ต้องเคลียร์ข้อมูลเก่าก็ลบได้คำสั่งนั้นไดเลยเลยครับ
:shock: :roll: :D
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#7

Post by aapichaya »

puriwutpokin wrote:ตามโค้ดถ้าไม่ต้องเคลียร์ข้อมูลเก่าก็ลบได้คำสั่งนั้นไดเลยเลยครับ
ขอบคุณมากค่ะ :D
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#8

Post by aapichaya »

ฝากtestให้หน่อยค่ะ พอดีลองอัพโหลดทีละสองไฟล์พร้อมกันแล้ว ผลคือขึ้นไฟล์แรกสองอัน พอจะมีวิธีแก้ไขไหมคะ

ปล.ลองtestเครื่องอื่นเเล้วimport ได้ปกติเเต่เครื่องตัวเองทำไม่ได้ :(
You do not have the required permissions to view the files attached to this post.
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#9

Post by aapichaya »

ผลจากการเทสในเครื่องตัวเองค่ะ
You do not have the required permissions to view the files attached to this post.
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#10

Post by aapichaya »

:cry: :cry: ขอโทษค่ะ ได้เเล้วค่ะพิมพ์โค้ดผิด
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#11

Post by aapichaya »

ถ้าเราต้องการImport ลงตารางเราต้องปรับโค้ดตรงไหนคะ ผลที่ต้องการอยู่ในชีทที่สองค่ะ ECR Approval ซึ่งการอัพโหลดข้อมูล ต้องการอัพโหลดต่อจากแถวสุดท้ายไปเรื่อยๆค่ะ
You do not have the required permissions to view the files attached to this post.
User avatar
puriwutpokin
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#12

Post by puriwutpokin »

ไฟล์ที่ Zip มาใหญ่มากเกินกำหนดครับ เปิดแล้วไม่มีข้อมูล เอาแค่ตัวอย่าง มาก็พอครับ
:shock: :roll: :D
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#13

Post by aapichaya »

ขอโทษนะคะ ตัวอย่างที่พี่ๆต้องการคือเเบบไหนคะ พอดีไฟล์ที่Zipไป(ไฟล์ข้อมูลที่ใช้อัพโหลด) ไม่สามารถแนบได้เนื่องจากนามสกุลไฟล์เป็น.csv ค่ะ
User avatar
puriwutpokin
Guru
Guru
Posts: 3693
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#14

Post by puriwutpokin »

Zip มาได้ครับ แต่ตัดข้อมูลให้เล็กลงครับ
:shock: :roll: :D
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#15

Post by snasui »

puriwutpokin wrote:Zip มาได้ครับ แต่ตัดข้อมูลให้เล็กลงครับ
:D จากที่ผมเปิดดูไฟล์ที่ Zip มาเป็นไฟล์ข้อมูลเป็น CSV ไฟล์ครับ เหตุผลที่ต้อง Zip เพราะไม่สามารถแนบ CSV ไฟล์ได้ ส่วนไฟล์โปรแกรมที่นำเข้าคือไฟล์นามสกุล .xlsm ครับ
aapichaya wrote:ถ้าเราต้องการImport ลงตารางเราต้องปรับโค้ดตรงไหนคะ ผลที่ต้องการอยู่ในชีทที่สองค่ะ ECR Approval ซึ่งการอัพโหลดข้อมูล ต้องการอัพโหลดต่อจากแถวสุดท้ายไปเรื่อยๆค่ะ
ตัวอย่าง Code ตามด้านล่าง การจัดการกับ Table จะยุ่งยากกว่าการจัดการกับ Range ปกติ จะมี ListObjects เข้ามาเกี่ยวข้องด้วยครับ

Code: Select all

Sub collectData()
    Dim wb As Workbook, s As Worksheet, db As Worksheet
    Dim StrPath As Variant, i As Integer, x As Integer
    StrPath = Application.GetOpenFilename(FileFilter:="All Excel Files," _
        & "*.xls; *.xlsx;*.xlsm;*.csv(Comma Separated Values);*.txt", _
        MultiSelect:=True)
    If TypeName(StrPath) = "Boolean" Then Exit Sub
    Set db = ThisWorkbook.Sheets(1)
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For i = 1 To UBound(StrPath)
        Set wb = Workbooks.Open(StrPath(i))
        For Each s In wb.Worksheets
           s.UsedRange.Offset(1, 0).Resize(s.UsedRange.Rows.Count - 1).Copy
           With db
               x = .ListObjects("Table4").Range.Rows.Count
               If .Range("a" & x).Value <> "" Then x = x + 1
               .Range("a" & x).PasteSpecial xlPasteValues
           End With
        Next s
        wb.Close False
        Application.ScreenUpdating = False
    Next i
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
aapichaya
Member
Member
Posts: 37
Joined: Wed Nov 08, 2017 7:55 am

Re: ขอสอบถามเกี่ยวกับโค้ดImport ข้อมูล

#16

Post by aapichaya »

ขอบคุณอาจารย์มากค่ะ
Post Reply