การแยกข้อมูล

[Bafnet]

สวัสดีครับอาจารย์ วันนี้มีเรื่องมารบกวนอีกแล้วครับ
งานที่ทำอยู่ตอนนี้คืบหน้าไป 50 % แล้วก็เจอปัญหาอีกแล้วครับ
คือผมนำเข้าไฟล์ข้อมูลลูกค้าจากระบบของธนาคาร แล้วสั่งแยกข้อมูลลงตาราง

1.jpg

ผมก็สั่งแยกที่อยู่ แต่ทำได้เฉพาะตัวที่มีช่องว่าง
71 ม.5 ต.ปล่องหอย
แต่พอเป็นแบบนี้
65ม.3ต.ปล่องหอยกิ่งอ.กะพ้อ หรือ 123/5ซ.1ถ.ตะลุบันอ.สายบุรี (สมมติว่าเป็นข้อมูลในเซลG3") ผมจะเขียนคำสั่งอย่างไรครับ
เพื่อให้ผลลัพท์ที่ได้ที่ข้อมูลแยกจากกันแบบนี้

2.jpg

เงื่อนไขคือในข้อมูลมันอาจเจอ
1. ตรอก
2. ซ.
3. ถ.
4. ม.
5. ต.
6. อ./กิ่งอ.
รบกวนอาจารย์แนะนำด้วยนะครับ ขอบคุณครับ

[snasui]

ช่วยส่งตัวอย่างมาเป็น Excel ไฟล์เพื่อสะดวกในการเขียนสูตรครับ

[Bafnet]

ขอโทษที่ช้าครับ ไฟล์มันใหญ่ เลยต้องสร้างในส่วนนี้ใหม่
รบกวนด้วยนะครับ

สมุดงาน1.xlsm

อาจารย์ครับข้อมูลในFileA ขออนุญาตส่งข้อมูลเป็นตัวอย่างจำนวนเท่านี้นะครับ
เนื่องจากมีจำนวนมากครับและเป็นข้อมูลธนาคาร ต้องขออภัยด้วยครับ
งานผมค่อนข้างมั่วๆนะครับ
ขอบคุณมากๆครับ

[snasui]

ลองดูตัวอย่างตามด้านล่างครับ

ที่ V1 เขียนสูตรเพื่อแทรกวรรคในข้อมูล จากนั้น Copy V1 มาไว้ที่ V3 แล้วค่อยทำ Text to columns จาก V3 นี้

สูตรที่ V1

=IF(ISNUMBER(SEARCH("กิ่งอ.",G3)),SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(G3,"ม."," ม."),"ต."," ต."),"กิ่งอ."," กิ่งอ."),"จ."," จ."),SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(G3,"ม."," ม."),"ต."," ต."),"อ."," อ."),"จ."," จ."))

Enter

และปรับ Code ที่ Sub Rep

Code: Select all

    Range("V3:AB3").Value = ""
    Range("V3") = Range("V1").Value
    Range("V3").Select

[Bafnet]

ขอบคุณมากครับอาจารย์
อาจารย์ช่วยอธิบายหลักการความหมายของสูตรให้หน่อยนะครับ
ผมเห็นสูตรในลักษณะนี้มาหลายครั้งแต่ไม่เข้าใจรูปแบบว่าแต่ละวรรคของการเขียนสูตรนี้มีความหมายอย่างไร
ซึ่งผมจะเห็นมันใช้ร่วมกับสูตรMID และ Len เราจะเข้าใจหรือศึกษาวิธีใช้สูตรพวกนี้จากที่ใดได้บ้างครับ
จะได้เขียนเพิ่มเติมครับเพราะสูตรที่อาจารย์ให้มายังไม่มีตรอก ซ.และ ถ.
และตามตัวอย่างข้อมูลของลูกค้าคนสุดท้ายจะมีชื่อบ้านติดกับเลขที่
เมื่อใช้สูตรที่อาจารย์ให้มา บ้านเลขที่ก็จะติดข้อความที่อยู่ด้านหลังมาด้วย
ถ้าที่V1 เราแยกตัวเลขที่เป็นบ้านเลขที่ออกจากข้อความก่อน จากนั้นนำข้อความที่เหลือไปกรองกับสูตรที่อาจารย์ให้มา
รบกวนด้วยนะครับ

[snasui]

ดูความหมายของสูตรได้ที่นี่ ==> Substitute ครับ การที่เห็นสูตรยาวเพราะเป็นการซ้อนสูตรเข้าไปเท่านั้นเอง

หลักการของสูตรคือเปลี่ยนค่าใด ๆ ให้เป็นอีกค่า สำหรับสูตรที่ผมเขียนให้นั้นเป็นการเปลี่ยน ถ. แบบไม่มีวรรคด้านหน้าเป็น ถ. แบบมีวรรคด้านหน้า เช่นนี้เป็นต้น

กรณีมี ตรอก, ซ. ฯลฯ ก็สามารถซ้อนสูตรเข้าไปได้อีกครับ สำหรับ 2007 สามารถซ้อนได้ถึง 64 ชั้นครับ อาจมีผู้สงสัยว่ากรณีมากกว่า 64 ชั้นจะทำอย่างไร เพื่อให้ง่ายให้ทำ 64 ชั้นแรกก่อน แล้วค่อยทำอีก 64 ชั้นในเซลล์ถัดไปเรื่อย ๆ

[Bafnet]

สวัสดีครับอาจารย์ เกิดเรื่องเศร้าใจครับ
ไฟล์เดิมผมสร้างโปรแกรมบน2003 และมาสร้างต่อบน2010 ซึ่งยังคงเป็นสกุล .xls
หลังจากซ้อนสูตรที่อาจารย์แนะนำมา และลดจำนวนชั้นของการซ้อนให้อยู่ในเกณฑ์ข้อจำกัดของ2003
ทุกอย่างก็ได้ดั่งใจครับ แต่พอสั่งเซฟงานมันก็บอกว่าเกิดข้อผิดพลาดร้ายแรงบันทึกไม่ได้ที่ทำมาก็หายไปหมด ที่เคยมีเส้นตารางก็หายไป
แต่ก็มีไฟล์สำรอง แต่เริ่มหวั่นใจว่าหากจะทำในสกุล2003 ต่อไป คงมีอันเป็นไปอีก
เลยตั้งใจจะแปลงจาก2003.xls ให้เป็น 2010.xlsm ขอปรึกษาอาจารย์หน่อยนะครับ
ในหน้าของวีบี มีเครื่องมือตัวใดบ้างที่จะช่วยเราค้นหาข้อความในคำสั่งที่เราเขียนไป เพื่อที่เราจะตามไปแก้ไข
เพราะผมอ้างถึงเวิร์กบุค และเวิร์กชีต ในสกุล.xls ยิ่งอธิบายก็ยิ่งงงกับตัวเอง
มีเครื่องมือที่ช่วยให้เราหาคำว่า.xls ในโปรเจคที่เราทำอยู่ไหมครับจะได้แก้ไขการอ้างอิงนั้นเป็น.xlsx หรือ .xlsm
ถ้าไม่มีคงต้องนั่งไล่ทีละคำสั่งทั้งหมด
ขอบคุณครับ

[snasui]

ใน VBE ใช้คำสั่งค้นหาโดยคลิกเมนู Edit > Find หรือกดแป้น Ctrl+F ครับ นอกจากจะค้นหาได้แล้วยังสามารถ Replace ได้อีกด้วย โดยการคลิก Edit > Replace หรือการกดแป้น Ctrl+H

[Bafnet]

ขอบพระคุณมากๆครับ น้ำตาซึมเลยครับ
ถ้าเราต้องการแก้ไขทั้งหมดในไฟล์งาน เราต้องเลือกที่ Option CurrentProject ใช่ใหม่ครับ
กรณี Replace เช่นผมให้หาคำว่า DumP.xls และให้แทนที่ด้วย DumP.xlsm เลือกAll
เรามั่นใจได้เลยใช่ไหมครับว่าDumP.xls ทุกที่ในไฟล์นี้กลายเป็น DumP.xlsm แล้ว
แสดงว่าในหน้างานของexcell ก็ต้องมีเครื่องมือที่อาจารย์แนะนำมาด้วยใช่ไหมครับเพราะมีบางสูตรผมVLOOKUP ข้ามเวิร์กบุ๊ค
ขอบคุณอีกครั้งครับ

[snasui]

ขอบพระคุณมากๆครับ น้ำตาซึมเลยครับ
ถ้าเราต้องการแก้ไขทั้งหมดในไฟล์งาน เราต้องเลือกที่ Option CurrentProject ใช่ใหม่ครับ

ใช่แล้วครับ

กรณี Replace เช่นผมให้หาคำว่า DumP.xls และให้แทนที่ด้วย DumP.xlsm เลือกAll
เรามั่นใจได้เลยใช่ไหมครับว่าDumP.xls ทุกที่ในไฟล์นี้กลายเป็น DumP.xlsm แล้ว

มั่นใจได้เลยครับ

แสดงว่าในหน้างานของexcell ก็ต้องมีเครื่องมือที่อาจารย์แนะนำมาด้วยใช่ไหมครับเพราะมีบางสูตรผมVLOOKUP ข้ามเวิร์กบุ๊ค

มีครับ กดแป้นตามที่ผมบอกไว้แล้วสังเกตดูผลครับ

[Bafnet]

ขอบคุณมากครับ ก็ได้ความรู้เพิ่มขึ้นอีกมากมาย
ขออนุญาตอาจารย์ไม่ตั้งกระทู้ใหม่นะครับ
ผมบันทึกมาโครในการนำเข้าข้อมูลจากภายนอก คือข้อมูลจากTable ที่ชื่อ FILEA จากACCESS ดังนี้
Sheets("FileA").Activate
Columns("A:V").Select
Selection.ClearContents
Selection.QueryTable.Delete
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Program Files\DumP\DATA\PALM.mdb;Mode=Share Deny Write" _
, _
";Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine " _
, _
"Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New " _
, _
"Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Comp" _
, "act=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("FILEA")
.Name = "PALM_12"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\Program Files\DumP\DATA\PALM.mdb"
.Refresh BackgroundQuery:=False
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("K1").Select
ActiveCell.FormulaR1C1 = "µÃÍ¡"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("L1").Select
ActiveCell.FormulaR1C1 = "«ÍÂ"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("M1").Select
ActiveCell.FormulaR1C1 = "¶¹¹"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("N1").Select
ActiveCell.FormulaR1C1 = "µÓºÅ"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("O1").Select
ActiveCell.FormulaR1C1 = "ÍÓàÀÍ"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("P1").Select
ActiveCell.FormulaR1C1 = "¨Ñ§ËÇÑ´"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("Q1").Select
ActiveCell.FormulaR1C1 = "àÅ¢·ÕèºÑµÃ»ÃЪҪ¹"
With ActiveCell.Characters(Start:=1, Length:=17).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("R1").Select
ActiveCell.FormulaR1C1 = "µÓá˹è§"
With ActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("S1").Select
ActiveCell.FormulaR1C1 = "àÅ¢·Õè¤Ùèâ͹"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("T1").Select
ActiveCell.FormulaR1C1 = "àºÍÃìâ·ÃµÔ´µèÍ"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("U1").Select
ActiveCell.FormulaR1C1 = "ÃËÑÊä»ÃɳÕÂì"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("V1").Select
ActiveCell.FormulaR1C1 = "´Ñª¹Õ"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "µÑÇ˹Ò"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
Range("V:V").Value = Range("A:A").Value
End With
บรรทัดนี้อยากให้มีคำสั่งให้หยุดการเชื่อมต่อข้อมูลหรือความสัมพันธ์ใดๆกับ Table ที่ชื่อFILEA (ไม่ให้เกี่ยวข้องกันอีกต่อไป)
End Sub
ผมต้องการให้นำเข้ามาแล้วก็จบ ไม่มีการเชื่อมโยงระหว่างกันอีก เพราะผมมีอีกหนึ่งคำสั่งที่ใช้โหลดข้อมูลไฟล์ธนาคารเมื่อต้องการข้อมุลที่เป็นปัจจุบัน
คำสั่งดังกล่าวจะทำการล้างข้อมูลใน PALM.mdb ทุกtable มีคำสั่งดังนี้
Sub mReadFile(sFile As String)
'On Error Resume Next
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cData As String
Dim cSQL As String
Dim oPROG2 As Object
Dim sFileOpen As String
Dim iLine, iMAX As Long
Dim sTemp As String
Dim iInstr As Byte
iLine = 1
iMAX = 1
sFileOpen = frmMain.txtFolder & "\" & sFile
cData = ThisWorkbook.Path + "\data\PALM.mdb"
'=============================
frmbranch.ProgressBar2.BorderStyle = ccFixedSingle
Select Case sFile

Case "FILEA" '---------------------------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData 'ãªé OLEDB ¢Í§ Jet Engine ADO 2.7 Libraly
cn.Execute "DELETE * FROM FILEA" 'ล้างข้อมูลทั้งหมด ตำแน่งที่Debug ไม่สามารถล้างได้เพราะtableดังกล่าวถูกใช้ข้อมูลอยู่จากคำสั่งแรก
cSQL = "select * from FILEA"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2

Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
rs.Fields(0).Value = Mid(sTemp, 1, 4) ' ˹èÇ rs ¤ÍÅÑÁ¹ìááàÃÔèÁµé¹ 0
rs.Fields(1).Value = (Mid(sTemp, 5, 5)) ' àÅ¢·ÐàºÕ¹
rs.Fields(2).Value = (Mid(sTemp, 10, 3)) ' ¡ÅØèÁ
rs.Fields(3).Value = Mid(sTemp, 13, 2) ' ࢵ
rs.Fields(4).Value = fClass(Mid(sTemp, 15, 1)) ' ÃËÑÊ˹Õé ªÑé¹ÅÙ¡¤éÒ
rs.Fields(5).Value = Trim(Mid(sTemp, 16, 35)) 'ª×èÍÊ¡ØÅ
rs.Fields(6).Value = Trim(Mid(sTemp, 51, 14)) '¤ÙèÊÁÃÊ
rs.Fields(7).Value = Trim(Mid(sTemp, 65, 26)) '·ÕèÍÂÙè
rs.Fields(8).Value = Mid(sTemp, 91, 1) ' ʶҹÐ
'᡺éÒ¹àÅ¢·ÕèáÅÐËÁÙè¤Ñè¹´éÇ #
sTemp = fCutAdress(rs.Fields(7)) '·ÕèÍÂÙè
iInstr = InStrRev(sTemp, "#")
rs.Fields(9).Value = Mid(sTemp, 1, iInstr - 1) 'ºéÒ¹àÅ¢·Õè text
rs.Fields(10).Value = Val(Mid(sTemp, iInstr + 1)) 'ËÁÙè Num ãªé cLng äÁè¼èÒ¹
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close

Case "FILEB" '---------------------------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
cn.Execute "DELETE * FROM FILEB" 'ÅéÒ§¢éÍÁÙÅ·Ñé§ËÁ´
cSQL = "select * from FILEB"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
'Cells(iLine + 5, 1) = sTemp
rs.Fields(0).Value = Mid(sTemp, 1, 8) 'ÊÑ­­Ò
rs.Fields(1).Value = Mid(sTemp, 9, 4) '˹èÇÂ
rs.Fields(2).Value = Mid(sTemp, 13, 5) 'àÅ¢·ÐàºÕ¹
rs.Fields(3).Value = Mid(sTemp, 18, 3) '¡ÅØèÁ
rs.Fields(4).Value = Mid(sTemp, 21, 2) '»ÃÐàÀ·ÊÑ­­Ò
rs.Fields(5).Value = fClass(Mid(sTemp, 23, 1)) 'ªÑé¹
rs.Fields(6).Value = Mid(sTemp, 24, 1) 'ËÅÑ¡»ÃСѹ
rs.Fields(7).Value = Mid(sTemp, 25, 9) 'ǧà§Ô¹¡Ùé
rs.Fields(8).Value = Mid(sTemp, 34, 9) 'â͹à§Ô¹¡Ùé
rs.Fields(9).Value = Mid(sTemp, 43, 4) 'ÊÑ­­ÒÊÔé¹ÊØ´
rs.Fields(10).Value = Mid(sTemp, 47, 5) / 1000 '
rs.Fields(11).Value = Mid(sTemp, 52, 9) '
rs.Fields(12).Value = Mid(sTemp, 61, 5) / 1000 '
rs.Fields(13).Value = Mid(sTemp, 66, 9) '
rs.Fields(14).Value = Mid(sTemp, 75, 1) '
rs.Fields(15).Value = Mid(sTemp, 76, 1) '
rs.Fields(16).Value = Mid(sTemp, 77, 2) '
rs.Fields(17).Value = Mid(sTemp, 79, 12) / 1000 '´Í¡àºÕéÂ
rs.Fields(18).Value = Mid(sTemp, 91, 12) '
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
oPROG2 = 0
rs.Update
rs.Close: cn.Close

Case "FILEC" '----------------¤Òº----------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
cn.Execute "DELETE * FROM FILEC_DUE " 'ÅéÒ§¢éÍÁÙÅ·Ñé§ËÁ´
cSQL = "select * from FILEC_DUE"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText

Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Dim sACC As String
Close #1
Open sFileOpen For Input As #1
Do While Not EOF(1)
Line Input #1, sTemp
sACC = Mid(sTemp, 1, 8)

If Mid(sTemp, 14, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 10, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 10, 2) '»Õ
rs.Fields(2).Value = Mid(sTemp, 12, 2) 'à´×͹
rs.Fields(3).Value = Mid(sTemp, 14, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 21, 4) ' §Ç´´Í¡
If Mid(sTemp, 29, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 25, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 25, 2) ' »Õ
rs.Fields(2).Value = Mid(sTemp, 27, 2) ' à´×͹
rs.Fields(3).Value = Mid(sTemp, 29, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 36, 4) ' §Ç´´Í¡
If Mid(sTemp, 44, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 40, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 40, 2) ' »Õ
rs.Fields(2).Value = Mid(sTemp, 42, 2) ' à´×͹
rs.Fields(3).Value = Mid(sTemp, 44, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 51, 4) ' §Ç´´Í¡
If Mid(sTemp, 59, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 55, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 55, 2) ' »Õ
rs.Fields(2).Value = Mid(sTemp, 57, 2) ' à´×͹
rs.Fields(3).Value = Mid(sTemp, 59, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 66, 4) ' §Ç´´Í¡
If Mid(sTemp, 74, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 70, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 70, 2) ' »Õ
rs.Fields(2).Value = Mid(sTemp, 72, 2) ' à´×͹
rs.Fields(3).Value = Mid(sTemp, 74, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 81, 4) ' §Ç´´Í¡
If Mid(sTemp, 89, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 85, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 85, 2) ' »Õ
rs.Fields(2).Value = Mid(sTemp, 87, 2) ' à´×͹
rs.Fields(3).Value = Mid(sTemp, 89, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 96, 4) ' §Ç´´Í¡
If Mid(sTemp, 104, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 100, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 100, 2) ' »Õ
rs.Fields(2).Value = Mid(sTemp, 102, 2) ' à´×͹
rs.Fields(3).Value = Mid(sTemp, 104, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 111, 4) ' §Ç´´Í¡
If Mid(sTemp, 119, 7) = "0000000" Then GoTo DOLOOP
rs.AddNew
rs.Fields(0).Value = sACC
'rs.Fields(1).Value = Mid(sTemp, 115, 4) ' §Ç´µé¹
rs.Fields(1).Value = Mid(sTemp, 115, 2) ' »Õ
rs.Fields(2).Value = Mid(sTemp, 117, 2) ' à´×͹
rs.Fields(3).Value = Mid(sTemp, 119, 7) ' à§Ô¹
rs.Fields(4).Value = Mid(sTemp, 126, 4) ' §Ç´´Í¡
DOLOOP: 'ǹÅÙ»ãËÁè
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100

Loop
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close

Case "FILED" '---------------------------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData 'ãªé OLEDB ¢Í§ Jet Engine ADO 2.7 Libraly
cn.Execute "DELETE * FROM FILED" 'ÅéÒ§¢éÍÁÙÅ·Ñé§ËÁ´
cSQL = "select * from FILED"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
rs.Fields(0).Value = Mid(sTemp, 1, 8)
rs.Fields(1).Value = Mid(sTemp, 9, 1)
rs.Fields(2).Value = Mid(sTemp, 10, 6)
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close

Case "CHKDUE" '---------¤ÕÂìµÒÁ˹Õé---------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
cn.Execute "DELETE * FROM CHKDUE" 'ÅéÒ§¢éÍÁÙÅ·Ñé§ËÁ´
cSQL = "select * from CHKDUE"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
rs.Fields(0).Value = Mid(sTemp, 1, 4)
rs.Fields(1).Value = Mid(sTemp, 5, 5)
rs.Fields(2).Value = Mid(sTemp, 10, 3)
rs.Fields(3).Value = Mid(sTemp, 13, 7)
rs.Fields(4).Value = Mid(sTemp, 20, 6)
rs.Fields(5).Value = Mid(sTemp, 26, 6)
rs.Fields(6).Value = Mid(sTemp, 32, 9)
rs.Fields(7).Value = Mid(sTemp, 41, 7)
rs.Fields(8).Value = Trim(Mid(sTemp, 48, 50))
rs.Fields(9).Value = Mid(sTemp, 98, 2)
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close

Case "CHKMAN" '---------------------------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
cn.Execute "DELETE * FROM CHKMAN"
cSQL = "select * from CHKMAN"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
rs.Fields(0).Value = Mid(sTemp, 1, 7)
rs.Fields(1).Value = Mid(sTemp, 8, 50)
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close

Case "PER1GARA" '---------------------------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
cn.Execute "DELETE * FROM PER1GARA"
cSQL = "select * from PER1GARA"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
rs.Fields(0).Value = Mid(sTemp, 1, 8)
rs.Fields(1).Value = Mid(sTemp, 9, 4)
rs.Fields(2).Value = Mid(sTemp, 13, 5)
rs.Fields(3).Value = Mid(sTemp, 18, 4)
rs.Fields(4).Value = Mid(sTemp, 22, 5)
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close


Case "PERGARAN" '---------------------------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
cn.Execute "DELETE * FROM PERGARAN"
cSQL = "select * from PERGARAN"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
rs.Fields(0).Value = Mid(sTemp, 1, 4)
rs.Fields(1).Value = Mid(sTemp, 5, 5)
rs.Fields(2).Value = Mid(sTemp, 10, 4)
rs.Fields(3).Value = Mid(sTemp, 14, 5)
rs.Fields(4).Value = Mid(sTemp, 19, 4)
rs.Fields(5).Value = Mid(sTemp, 23, 5)
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close

Case "REGASSET" '---------------------------------------------------------------------------------------------
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cData
cn.Execute "DELETE * FROM REGASSET"
cSQL = "select * from REGASSET"
rs.Open cSQL, cn, adUseClient, adLockPessimistic, adCmdText
Set oPROG2 = frmbranch.ProgressBar2
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
iMAX = iMAX + 1
Wend
Close #1
Open sFileOpen For Input As #1
While Not EOF(1)
Line Input #1, sTemp
rs.AddNew
rs.Fields(0).Value = Mid(sTemp, 1, 4)
rs.Fields(1).Value = Mid(sTemp, 5, 5)
rs.Fields(2).Value = Mid(sTemp, 10, 3)
rs.Fields(3).Value = Mid(sTemp, 13, 1)
rs.Fields(4).Value = Mid(sTemp, 14, 2)
rs.Fields(5).Value = Mid(sTemp, 16, 4)
rs.Fields(6).Value = Mid(sTemp, 20, 1)
rs.Fields(7).Value = Mid(sTemp, 21, 2)
rs.Fields(8).Value = Mid(sTemp, 23, 9)
iLine = iLine + 1
oPROG2 = iLine / iMAX * 100
Wend
Close #1
rs.Update
oPROG2 = 0
rs.Close: cn.Close


'// Case "control" '-------------------------------
End Select
frmbranch.ProgressBar2.BorderStyle = ccNone
End Sub
อยากส่งไฟล์ให้อาจารย์แต่ไฟล์มันใหญ่ครับ ขออภัยด้วยครับ
ถามนอกเรื่องสักนิดนะครับ เวลาcoppy คำสั่งวีบี มาวางในฟอรั่มทำยังไงไม่ให้ภาษาไทยกลายเป็นภาษาต่างดาวครับ

[snasui]

กรณีต้องการตัดการเชื่อมต่อสามารถใช้คำสั่ง Delete QueryTable ได้ครับ เช่นตามด้านล่าง

Code: Select all

ActiveSheet.QueryTables(1).Delete

ส่วนการ Copy ภาษาไทยใน VBE มาแล้วแสดงเป็นภาษาต่างดาว ผมเองก็เป็นเหมือนกันครับ เดาว่าน่าจะเกิดจากการตั้งค่าภาษาใน VBE เพราะบางเครื่องที่ผมใช้ไม่มีปัญหาดังกล่าว จะลองสังเกตว่าเครื่องนั้นกำหนดอย่างไรครับ

[Bafnet]

สวัสดีอีกครั้งครับ
การ ActiveSheet.QueryTables(1).Delete
ได้ผลครับ ตอนแรกลองนำคำสั่งนี้ใช้ใน2003 ก็นั่งเครียดครับไม่ส่งผลใด
คือผมรีบเกินสั่งคำสั่งนี้เสร็จก็ไปลองสั่งคำสั่งที่โหลดข้อมูลแบงค์ลงAccess
ไปๆมาๆได้ผลครับ แต่ต้องรอสักหนึ่งอึดใจ อาจเป็นเพราะคอมผมโบราณ
ขอบคุณครับ