ตรวจสอบและปรับปรุงไฟล์ Excel ให้เร็วและเสถียรด้วย File Anatomy Add-in
เครื่องมือนี้ช่วยวิเคราะห์โครงสร้างไฟล์อย่างละเอียด เช่น สูตร, ลิงก์, PivotTable, Styles และ Objects
พร้อมฟังก์ชันล้างสิ่งเกินจำเป็นที่ทำให้ไฟล์ช้า หรือเสียหายได้ในคลิกเดียว
เหมาะสำหรับผู้ใช้ Excel ที่ต้องการควบคุมคุณภาพไฟล์อย่างมืออาชีพ
ทดลองใช้ Add-in
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
ระบุ Version ของ Excel 
โปรดทราบ สมัครสมาชิก
Login ผ่าน Facebook Reset รหัสผ่าน ติดต่อผู้ดูแลระบบ ตั้งค่าส่วนตัว วิธีการตั้งและตอบกระทู้ จัดรูปแบบตัวอักษร กำหนดขนาดตัวอักษรใน Browser[code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
Code: Select all
Sub ImportItemMaster()
Dim strPath As Variant, i As Integer
Dim fName As String, nb As Workbook
Dim tb As Workbook, ans As Integer, lngLast As Long
Set tb = ThisWorkbook
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)
For p = 1 To 4
fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
Workbooks.OpenText Filename:=strPath(i), origin:=65001, _
startrow:=1, DataType:=xlDelimited, textQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, other:=True, OtherChar:="|", fieldinfo:=Array(Array(1, 2 _
), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), 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, 1), _
Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
Array(48, 1)), TrailingMinusNumbers:=True
lngLast = Range("A" & Rows.Count).End(xlUp).Row
With ActiveWorkbook
Sheets(1).Select
Range("a1:av" & lngLast).Copy
End With
With tb.Sheets("Item" & p)
Sheets("Item" & p).Select
.Range("a1").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
Workbooks("ITEMMASTER.TXT-" & R & ".txt*").Close
Next p
Next i
MsgBox "Finish."
End Sub
Import.xlsm
TextItemMasterหลายไฟล์หลายชีท.rar
ตัวอย่างสูตรในชีต ค้นหา เซลล์ D5 ครับCode: Select all
Dim sh As Worksheet, i As Integer
Dim strPath As Variant, q As Object
strPath = Application.GetOpenFilename(FileFilter:="Text File(s) (*.txt),*.txt*", _
MultiSelect:=True)
If TypeName(strPath) = "Boolean" Then Exit Sub
For Each sh In ThisWorkbook.Worksheets
If sh.Index > 1 Then
i = i + 1
With sh.QueryTables.Add(Connection:= _
"TEXT;" & strPath(i), Destination:=sh.Range("a1"))
.Name = VBA.Right(strPath(i), InStr(StrReverse(strPath(i)), "\") - 1)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
For Each q In sh.QueryTables
q.Delete
Next
Next sh
ขอบคุณมากครับอาจารย์ สำหรับโค้ดใช้งานได้ดีเลยครับ ส่วนสูตรหากต้องการใช้กับตัวเลข เช่น Group ต้องปรับสูตรอย่างไรครับsnasui wrote: Wed Mar 06, 2019 11:05 pm
=LOOKUP(CHAR(255),CHOOSE({1,2,3,4,5},"",LOOKUP(2,1/(Item1!$A$2:$A$10000=C5),Item1!$C$2:$C$10000),LOOKUP(2,1/(Item2!$A$2:$A$10000=C5),Item2!$C$2:$C$10000),LOOKUP(2,1/(Item3!$A$2:$A$10000=C5),Item3!$C$2:$C$10000),LOOKUP(2,1/(Item4!$A$2:$A$10000=C5),Item4!$C$2:$C$10000)))
ตัวอย่าง Code ครับ
Code: Select all
Dim sh As Worksheet, i As Integer Dim strPath As Variant, q As Object strPath = Application.GetOpenFilename(FileFilter:="Text File(s) (*.txt),*.txt*", _ MultiSelect:=True) If TypeName(strPath) = "Boolean" Then Exit Sub For Each sh In ThisWorkbook.Worksheets If sh.Index > 1 Then i = i + 1 With sh.QueryTables.Add(Connection:= _ "TEXT;" & strPath(i), Destination:=sh.Range("a1")) .Name = VBA.Right(strPath(i), InStr(StrReverse(strPath(i)), "\") - 1) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 65001 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileOtherDelimiter = "|" .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End If For Each q In sh.QueryTables q.Delete Next Next sh
parakorn wrote: Thu Mar 07, 2019 4:52 pm ส่วนสูตรหากต้องการใช้กับตัวเลข เช่น Group ต้องปรับสูตรอย่างไรครับ
ปรับสูตรเป็นด้านล่างครับ 
