Note: The other languages of the website are Google-translated. Back to English
English English

วิธีการนำเข้าไฟล์ข้อความหลายไฟล์จากโฟลเดอร์ลงในแผ่นงานเดียว

สำหรับอินสแตนซ์ที่นี่คุณมีโฟลเดอร์ที่มีไฟล์ข้อความหลายไฟล์สิ่งที่คุณต้องการทำคือการนำเข้าไฟล์ข้อความเหล่านี้ลงในแผ่นงานเดียวดังภาพหน้าจอด้านล่าง แทนที่จะคัดลอกไฟล์ข้อความทีละไฟล์มีเคล็ดลับในการนำเข้าไฟล์ข้อความจากโฟลเดอร์หนึ่งไปยังแผ่นเดียวอย่างรวดเร็วหรือไม่?

นำเข้าไฟล์ข้อความหลายไฟล์จากโฟลเดอร์เดียวลงในแผ่นงานเดียวด้วย VBA

นำเข้าไฟล์ข้อความไปยังเซลล์ที่ใช้งานอยู่ด้วย Kutools for Excel ความคิดที่ดี 3


นี่คือรหัส VBA สามารถช่วยคุณนำเข้าไฟล์ข้อความทั้งหมดจากโฟลเดอร์เฉพาะไปยังแผ่นงานใหม่

1. เปิดใช้งานสมุดงานที่คุณต้องการนำเข้าไฟล์ข้อความแล้วกด Alt + F11 คีย์เพื่อเปิดใช้งาน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2 คลิก สิ่งที่ใส่เข้าไป > โมดูลคัดลอกและวางโค้ด VBA ด้านล่างลงในไฟล์ โมดูล หน้าต่าง

VBA: นำเข้าไฟล์ข้อความหลายไฟล์จากโฟลเดอร์หนึ่งไปยังแผ่นเดียว

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3 กด F5 เพื่อแสดงกล่องโต้ตอบและเลือกโฟลเดอร์ที่มีไฟล์ข้อความที่คุณต้องการนำเข้า ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 1

4 คลิก OK. จากนั้นไฟล์ข้อความจะถูกนำเข้าสู่สมุดงานที่ใช้งานเป็นแผ่นงานใหม่แยกกัน
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 2


หากคุณต้องการนำเข้าไฟล์ข้อความหนึ่งไฟล์ไปยังเซลล์หรือช่วงที่ต้องการคุณสามารถสมัครได้ Kutools สำหรับ Excel's แทรกไฟล์ที่เคอร์เซอร์ ประโยชน์

Kutools สำหรับ Excel, ที่มีมากกว่า 300 ฟังก์ชั่นที่มีประโยชน์ทำให้งานของคุณง่ายขึ้น 

หลังจาก ติดตั้งฟรี Kutools สำหรับ Excel โปรดทำดังนี้:

1. เลือกเซลล์ที่คุณต้องการนำเข้าไฟล์ข้อความแล้วคลิก Kutools พลัส > นำเข้าส่งออก > แทรกไฟล์ที่เคอร์เซอร์. ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 3

2. จากนั้นกล่องโต้ตอบจะปรากฏขึ้นให้คลิก หมวดหมู่สินค้า เพื่อแสดง เลือกไฟล์ ที่จะแทรกที่กล่องโต้ตอบตำแหน่งเคอร์เซอร์ของเซลล์ให้เลือกถัดไป ไฟล์ข้อความ จากรายการแบบหล่นลงจากนั้นเลือกไฟล์ข้อความที่คุณต้องการนำเข้า ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 4

3 คลิก จุดเปิด > Okและไฟล์ข้อความระบุถูกแทรกที่ตำแหน่งเคอร์เซอร์ดูภาพหน้าจอ:
doc นำเข้าไฟล์ข้อความจากโฟลเดอร์ 5


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel ช่วยแก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office / Excel 2007-2019 และ 365 รองรับทุกภาษา ใช้งานง่ายในองค์กรหรือองค์กรของคุณ ทดลองใช้ฟรี 30 วันเต็ม รับประกันคืนเงิน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มผลผลิตของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (41)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
การทดสอบย่อย ()
'UpdatebyExtendoffice6 / 7 / 2016
Dim xWb เป็นสมุดงาน
Dim xToBook เป็นสมุดงาน
Dim xStrPath เป็นสตริง
Dim xFileDialog เป็น FileDialog
Dim xFile เป็นสตริง
Dim xFiles เป็นคอลเล็กชั่นใหม่
หรี่ฉันนาน
ตั้งค่า xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = เท็จ
xFileDialog.Title = "เลือกโฟลเดอร์ [Kutools for Excel]"
ถ้า xFileDialog.Show = -1 แล้ว
xStrPath = xFileDialog.SelectedItems(1)
End If
ถ้า xStrPath = "" จากนั้นออกจาก Sub
ถ้าใช่ (xStrPath, 1) <> "\" จากนั้น xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
ถ้า xFile = "" แล้ว
MsgBox "ไม่พบไฟล์", vbInformation, "Kutools สำหรับ Excel"
ออกจาก Sub
End If
ทำในขณะที่ xFile <> ""
xFiles เพิ่ม xFile, xFile
xFile = ไดร์()
ห่วง
ตั้งค่า xToBook = ThisWorkbook
ถ้า xFiles.Count > 0 แล้ว
สำหรับฉัน = 1 ถึง xFiles.Count
ตั้งค่า xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
เกี่ยวกับข้อผิดพลาดต่อไป
ActiveSheet.Name = xWb.Name
เมื่อเกิดข้อผิดพลาด GoTo 0
xWb.ปิด เท็จ
ต่อไป
End If
ย่อยสิ้นสุด

รหัสนี้ช่วยได้ แต่ฉันต้องการ

tab, กึ่งโคลอน, สเปซทรู ทำอย่างไร โปรดช่วยฉันด้วย
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณต้องการเก็บช่องว่าง (ตัวคั่น) หลังจากแปลงไฟล์ข้อความเป็นแผ่นงานหรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นั่นคือปัญหาของฉันเช่นกัน รหัสนี้เป็นจริง แต่หลังจากแปลงไฟล์ข้อความเป็น excel จะไม่เก็บตัวคั่นไว้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณช่วยอัปโหลดไฟล์ข้อความและผลลัพธ์ที่ต้องการให้ฉันได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ผมมีปัญหาเดียวกัน. ไฟล์ txt ทั้งหมดอยู่ในชีตแยกกัน และโค้ดจะไม่สนใจช่องว่างระหว่างสองคอลัมน์
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Des และ PB Rama Murty โค้ดด้านล่างสามารถแบ่งข้อมูลออกเป็นคอลัมน์ตามพื้นที่หรือแท็บขณะนำเข้าไฟล์ข้อความไปยังชีต คุณสามารถลอง

ย่อย ImportTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb เป็นสมุดงาน
Dim xToBook เป็นสมุดงาน
Dim xStrPath เป็นสตริง
Dim xFileDialog เป็น FileDialog
Dim xFile เป็นสตริง
Dim xFiles เป็นคอลเล็กชั่นใหม่
หรี่ฉันนาน
Dim xIntRow ตราบใดที่
xFNum หรี่, xFArr นาน
Dim xStrValue เป็นสตริง
Dim xRg เป็นช่วง
หรี่ xArr
ตั้งค่า xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = เท็จ
xFileDialog.Title = "เลือกโฟลเดอร์ [Kutools for Excel]"
ถ้า xFileDialog.Show = -1 แล้ว
xStrPath = xFileDialog.SelectedItems(1)
End If
ถ้า xStrPath = "" จากนั้นออกจาก Sub
ถ้าใช่ (xStrPath, 1) <> "\" จากนั้น xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
ถ้า xFile = "" แล้ว
MsgBox "ไม่พบไฟล์", vbInformation, "Kutools สำหรับ Excel"
ออกจาก Sub
End If
ทำในขณะที่ xFile <> ""
xFiles เพิ่ม xFile, xFile
xFile = ไดร์()
ห่วง
ตั้งค่า xToBook = ThisWorkbook
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
ถ้า xFiles.Count > 0 แล้ว

สำหรับฉัน = 1 ถึง xFiles.Count
ตั้งค่า xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.ปิด เท็จ
xIntRow = ActiveCell.CurrentRegion.Rows.Count
สำหรับ xFNum = 1 ถึง xIntRow
ตั้งค่า xRg = ActiveSheet.Range("A" & xFNum)
xArr = แยก (xRg.Text, " ")
ถ้า UBound(xArr) > 0 แล้ว
สำหรับ xFArr = 0 ถึง UBound(xArr)
ถ้า xArr(xFArr) <> "" แล้ว
xRg.Value = xArr(xFArr)
ตั้งค่า xRg = xRg.Offset(ColumnOffset:=1)
End If
ต่อไป
End If
ต่อไป
ต่อไป
End If
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
จำเป็นต้องเปลี่ยนแปลงอะไรบ้างหากต้องการแบ่งข้อมูลออกเป็นคอลัมน์ตามเครื่องหมายจุลภาค
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ต้องเปลี่ยนแปลงอะไรบ้างหากฉันต้องการข้อมูลทีโอทีลงในคอลัมน์ตามเครื่องหมายจุลภาค
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
จะทำอย่างไรถ้าไฟล์ Txt ของฉันมีการคั่นด้วยเครื่องหมายจุลภาค?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณสามารถใช้ Find and Replace fuctuon เพื่อแทนที่เครื่องหมายจุลภาคด้วยช่องว่างก่อน และใช้วิธีใดวิธีหนึ่งข้างต้นเพื่อแปลงเป็นไฟล์ Excel
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ไม่มีวิธีการเปลี่ยนสิ่งนี้ในรหัสหรือไม่ ฉันต้องทำเช่นนี้กับ 130 ไฟล์
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คำถามเดียวกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สำหรับผู้ที่ยังต้องการความช่วยเหลือในเรื่องนี้ ให้แทนที่ xArr = Split(xRg.Text, " ") ด้วย xArr = Split(xRg.Text, ",")
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เมื่อฉันเรียกใช้โมดูลตามที่กำหนด มันจะเพิ่มไฟล์ .txt แต่ละไฟล์เป็นชีตใหม่ ไม่ใช่ขึ้นบรรทัดใหม่ในชีตที่มีอยู่ มีวิธีทำให้สำเร็จเป็นผลลัพธ์แทนชีตใหม่สำหรับไฟล์ .txt แต่ละไฟล์หรือไม่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณหมายถึงการรวมไฟล์ข้อความทั้งหมดเป็นแผ่นเดียวหรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ใช่ นี่คือสิ่งที่ฉันต้องการเช่นกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Davinder คุณสามารถลองใช้รหัส vba ด้านล่าง
Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสมีประโยชน์มาก มันเป็นรหัสเดียวที่ฉันพบว่าได้รับไฟล์ txt จำนวนมาก การแก้ไขที่ฉันต้องการในนั้นคือสิ่งที่ Joyce และ Davinder ตามหา
มันคือการแยกไฟล์ .txt และวางทั้งหมดไว้ใต้กันในคอลัมน์เฉพาะ เช่น คอลัมน์ 'N'

นอกจากนี้ จำเป็นต้องทราบด้วยว่าจะสามารถเพิ่ม "เงื่อนไขเงื่อนไข" สำหรับไฟล์ .txt ที่นำเข้าได้ดังนี้หรือไม่
หากไฟล์ .txt ขึ้นต้นด้วยตัวอักษร 'A' ให้วางใน 'ชีต 1' โดยขึ้นต้นด้วยเซลล์ 'N2'
และหากไฟล์ .txt ขึ้นต้นด้วยตัวอักษร 'B' ให้วางใน 'ชีต 2' ที่ขึ้นต้นด้วยเซลล์ 'N2'
มิฉะนั้น MsgBox จะเป็น "วัตถุประสงค์ของไฟล์ .txt ที่ไม่รู้จัก"

ขอขอบคุณล่วงหน้า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีรหัสนี้ใช้งานได้สำหรับฉัน แต่ยังต้องเปลี่ยนบางอย่างในนั้น

*ฉันต้องการให้มันวางบนแผ่นงานเดิมโดยไม่ต้องเปิดแผ่นงานใหม่แล้วจึงคัดลอกเพราะมันใช้เวลานานกว่านั้น

*จำเป็นต้องแทรกเงื่อนไขหากไฟล์ txt ที่นำเข้ามาวางบนแผ่นที่ 1 หากขึ้นต้นด้วยตัวอักษร A และนำเข้าไปยังแผ่นที่ 2 หากขึ้นต้นด้วยตัวอักษร B


ย่อย testcopy3()
Dim xWb เป็นสมุดงาน
Dim xToBook เป็นสมุดงาน
Dim xStrPath เป็นสตริง
Dim xFileDialog เป็น FileDialog
Dim xFile เป็นสตริง
Dim xFiles เป็นคอลเล็กชั่นใหม่
มืดมนตราบนานเท่านาน
หรี่ LastRow As Long
Dim Rng เป็นช่วง
ตั้งค่า xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = เท็จ
xFileDialog.Title = "เลือกโฟลเดอร์ [Kutools for Excel]"
ถ้า xFileDialog.Show = -1 แล้ว
xStrPath = xFileDialog.SelectedItems(1)
End If
ถ้า xStrPath = "" จากนั้นออกจาก Sub
ถ้าใช่ (xStrPath, 1) <> "\" จากนั้น xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
ถ้า xFile = "" แล้ว
MsgBox "ไม่พบไฟล์", vbInformation, "Kutools สำหรับ Excel"
ออกจาก Sub
End If
ทำในขณะที่ xFile <> ""
xFiles เพิ่ม xFile, xFile
xFile = ไดร์()
ห่วง
ช่วง("N2") เลือก
ตั้งค่า xToBook = ThisWorkbook
ถ้า xFiles.Count > 0 แล้ว
สำหรับฉัน = 1 ถึง xFiles.Count
ตั้งค่า xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
xWb.เปิดใช้งาน
'การเลือกและคัดลอกข้อมูล txt
ช่วง(Selection, Selection.End(xlDown)).Select
Selection.Copy
xToBook.เปิดใช้งาน
ActiveSheet วาง
Selection.End(xlDown).Offset(1).Select
เกี่ยวกับข้อผิดพลาดต่อไป
เมื่อเกิดข้อผิดพลาด GoTo 0
xWb.ปิด เท็จ
ต่อไป
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอโทษ มือฉันถูกมัด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี รหัสของฉันทำงานแต่นำเข้าเฉพาะไฟล์แรก มันบอกว่ามีข้อผิดพลาดของวิธีการคัดลอก ดีบักเกอร์เน้นบรรทัดของรหัสต่อไปนี้ ความคิดใด?


xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีปัญหาเดียวกัน พบวิธีแก้ไขใด ๆ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เฮ้ เคธี่
ฉันรู้ว่าความคิดเห็นของคุณค่อนข้างเก่า แต่ฉันประสบปัญหาเดียวกันและแก้ไขด้วยวิธีนี้: ต้องแทรกโมดูลในโฟลเดอร์ย่อยของโปรเจ็กต์ .xlsx ที่ใช้งานอยู่ ฉันทำผิดพลาดในการคัดลอกโค้ดลงในโฟลเดอร์ย่อยของ PERSONAL.XLSB ซึ่งฉันมักจะเก็บมาโครและใช้กับมาโครอื่นๆ ของฉัน แต่ไม่ใช่กับมาโครนี้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณจะลบชีตในโค้ด vba อย่างไรหากคุณไม่ต้องการให้ซ้ำกันในการเรียกใช้งานโมดูลอีกครั้ง
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขออภัย Harsh โปรดใช้ความระมัดระวังเพื่อหลีกเลี่ยงการนำเข้าซ้ำ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันต้องการป้องกันการลบเลขศูนย์ที่อยู่ข้างหน้าใน excel

ฉันลองโค้ดด้านล่างแล้ว แต่มันใช้งานไม่ได้


การทดสอบย่อย ()
Dim xWb เป็นสมุดงาน
Dim xToBook เป็นสมุดงาน
Dim xStrPath เป็นสตริง
Dim xFileDialog เป็น FileDialog
Dim xFile เป็นสตริง
Dim xFiles เป็นคอลเล็กชั่นใหม่
หรี่ฉันนาน
ติ่ม j ตราบ
ตั้งค่า xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = เท็จ
xFileDialog.Title = "เลือกโฟลเดอร์"
ถ้า xFileDialog.Show = -1 แล้ว
xStrPath = xFileDialog.SelectedItems(1)
End If
ถ้า xStrPath = "" จากนั้นออกจาก Sub
ถ้าใช่ (xStrPath, 1) <> "\" จากนั้น xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
ถ้า xFile = "" แล้ว
MsgBox "ไม่พบไฟล์", vbInformation, "Kutools สำหรับ Excel"
ออกจาก Sub
End If
ทำในขณะที่ xFile <> ""
xFiles เพิ่ม xFile, xFile
xFile = ไดร์()
ห่วง
ตั้งค่า xToBook = ThisWorkbook
ถ้า xFiles.Count > 0 แล้ว
สำหรับฉัน = 1 ถึง xFiles.Count
ตั้งค่า xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
ActiveSheet.Cells.NumberFormat = "@" 'นี่คือการสร้าง excel ในรูปแบบข้อความก่อนที่จะวางข้อมูลไฟล์ข้อความ
xWb.Worksheets(1).Copy After:=xToBook.Sheets(xToBook.Sheets.Count)
เกี่ยวกับข้อผิดพลาดต่อไป
ActiveSheet.Name = xWb.Name
เมื่อเกิดข้อผิดพลาด GoTo 0
xWb.ปิด เท็จ
ต่อไป
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Pooja คุณสามารถลองใช้ฟังก์ชัน Remove Leading Zeros ของ Kutools for Excel เพื่อลบศูนย์นำหน้าทั้งหมดออกจากการเลือกหลังจากนำเข้า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
แต่ไม่อยากถอด ฉันต้องการป้องกันไม่ให้ลบเลขศูนย์นำหน้า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ถ้าคุณต้องการเก็บเลขศูนย์นำหน้า คุณสามารถจัดรูปแบบให้เป็นรูปแบบข้อความโดยใช้รูปแบบเซลล์
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี คุณจะแก้ไขโค้ดนี้เพื่อแทรกไฟล์ *.txt ตามลำดับได้อย่างไร: 1,2,3,4,5,6,7,8,9,10,11 เป็นต้น ขณะนี้โค้ดแทรกไฟล์ดังนี้:1,10,11,12,13,14,15,16,17,18,19,2,20,21, XNUMX ฯลฯ ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มีโอกาสใช้ชื่อแผ่นงานเพียงบางส่วนจากชื่อไฟล์ txt หรือไม่?

ตามรหัสข้างต้นชื่อแผ่นงานทั้งหมดได้รับ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณมาก งานใน office 2007 excel
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี รหัสของฉันทำงานแต่นำเข้าเฉพาะไฟล์แรก มันบอกว่ามีข้อผิดพลาดของวิธีการคัดลอก ดีบักเกอร์เน้นบรรทัดของรหัสต่อไปนี้ ความคิดใด?


xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เฮ้ มาร์ตินโญ่
ฉันมีปัญหาเดียวกันและแก้ไขโดยเปลี่ยนบรรทัดนี้:
ตั้งค่า xToBook = ThisWorkbook
ไปยัง
ตั้งค่า xToBook = ActiveWorkbook
บางทีนี่อาจช่วยได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
0

ฉันต้องการให้คุณช่วย ฉันไม่มีความคิดใด ๆ vba excel ฉันต้องการนำเข้าไฟล์ข้อความหลายไฟล์เช่น 13000 ชื่อไฟล์ข้อความเหมือนกับเซลล์เช่น (c1 = 112 ดังนั้นชื่อไฟล์ข้อความก็คือ 112) หมายความว่าไฟล์ข้อความ 112 คือ นำเข้า c112
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันต้องการให้คุณช่วย ฉันไม่มีความคิดใด ๆ vba excel ฉันต้องการนำเข้าไฟล์ข้อความหลายไฟล์เช่น 13000 ชื่อไฟล์ข้อความเหมือนกับเซลล์เช่น (c1 = 112 ดังนั้นชื่อไฟล์ข้อความก็คือ 112) หมายความว่าไฟล์ข้อความ 112 คือ นำเข้า c112
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสใช้งานได้ แต่จะนำเข้าไฟล์ข้อความแต่ละไฟล์ไปยังแท็บใหม่ในสมุดงาน มีแนวคิดใดบ้างที่สามารถเปลี่ยนแปลงโค้ดนี้เพื่อนำเข้าไฟล์ข้อความใหม่บนเวิร์กชีตเดียวกันด้านล่างข้อมูลจากไฟล์ข้อความล่าสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ในโค้ดด้านล่างหากฉันต้องการระบุโฟลเดอร์แทนที่จะเลือกพาธทุกครั้งที่นำเข้าไฟล์ข้อความ ต้องแก้ไขอะไรบ้าง

รหัส VBA:

นำเข้าย่อย CSVsWithReference()
'UpdatebyKutoolsforExcel20151214 .'
Dim xSht เป็นแผ่นงาน
Dim xWb เป็นสมุดงาน
Dim xStrPath เป็นสตริง
Dim xFileDialog เป็น FileDialog
Dim xFile เป็นสตริง
เกิดข้อผิดพลาด GoTo ErrHandler
ตั้งค่า xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = เท็จ
xFileDialog.Title = "เลือกโฟลเดอร์ [Kutools for Excel]"
ถ้า xFileDialog.Show = -1 แล้ว
xStrPath = xFileDialog.SelectedItems(1)
End If
ถ้า xStrPath = "" จากนั้นออกจาก Sub
ตั้งค่า xSht = ThisWorkbook.ActiveSheet
ถ้า MsgBox("ล้างแผ่นงานที่มีอยู่ก่อนที่จะนำเข้า?", vbYesNo, "Kutools for Excel") = vbYes จากนั้น xSht.UsedRange.Clear
Application.ScreenUpdating = เท็จ
xFile = Dir(xStrPath & "\" & "*.txt")
ทำในขณะที่ xFile <> ""
ตั้งค่า xWb = Workbooks.Open (xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.ปิด เท็จ
xFile = ผู้อำนวยการ
ห่วง
Application.ScreenUpdating = จริง
ออกจาก Sub
ตัวจัดการข้อผิดพลาด:
MsgBox "ไม่มีไฟล์ txt", "Kutools สำหรับ Excel"
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี โปรดลองรหัสด้านล่าง
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

"C:\Users\AddinsVM001\Desktop\test" เป็นพาธของโฟลเดอร์ที่คุณอาจนำเข้าไฟล์ข้อความ โปรดเปลี่ยนตามที่คุณต้องการ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ขอบคุณสำหรับรหัส VBA อันมีค่าของคุณ
อย่างไรก็ตาม ฉันต้องการรหัสสำหรับไฟล์ txt หลายไฟล์เป็น 'แผ่นงานเดียวในเวิร์กชีต ไม่ใช่แผ่นงานสำหรับไฟล์ txt แต่ละไฟล์'
ฉันควรแก้ไขรหัสของคุณเพื่อจุดประสงค์ของฉันอย่างไร

ขอบคุณ,
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี โปรดลองรหัสด้านล่าง
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ