ตรวจสอบและปรับปรุงไฟล์ 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
Private Sub CommandButton1_Click()Dim regEx, myMatch, myMatches, arg
Dim i As String
Dim j As Integer
Set regEx = CreateObject("vbscript.regexp")
For j = 1 To 4
arg = Range("A" & j).Value
With regEx
.Pattern = "\d{1}"
.Global = True
If .Test(arg) Then
Set myMatches = .Execute(arg)
i = ""
For Each myMatch In myMatches
i = i & "." & myMatch.Value
Next myMatch
MsgBox ("E" & i)
End If
End With
Next j
End Sub
จากไฟล์ที่แนบมา ตัวอย่าง Code การตัดให้คงเหลือเฉพาะค่าที่ต้องการตามด้านล่างครับ
Code: Select all
Sub Test0()
Dim rAll As Range, r As Range
Dim t As String, i As Integer
Set rAll = Sheets("Sheet1").Range("A1:A4")
For Each r In rAll
With Application.WorksheetFunction
t = .Substitute(r, " Network Settings", "")
i = .Search(" ", t) - 1
r.Offset(0, 1) = Left(t, i)
End With
Next r
End Sub
รบกวนอีกนิดครับ ถ้าในกรณีทีไม่ได้ใช้คำว่า "Network Settings" เหมือนกันล่ะครับ ใช้ึคำที่แตกต่างกันออกไป จะต้องแก้เป็นยังไงครับsnasui wrote:ส่วนการแสดงค่าทั้งหมดกรณีคั่นด้วยเครื่องหมาย - ลองประยุกต์จากที่นี่ครับ Split then JoinCode: Select all
Sub Test0() Dim rAll As Range, r As Range Dim t As String, i As Integer Set rAll = Sheets("Sheet1").Range("A1:A4") For Each r In rAll With Application.WorksheetFunction t = .Substitute(r, " Network Settings", "") i = .Search(" ", t) - 1 r.Offset(0, 1) = Left(t, i) End With Next r End Sub
ควรถามด้วยตัวอย่างที่เป็นตัวแทนของข้อมูลจริงครับ จะได้ทราบว่าข้อมูลมีความหลากหลายอย่างไร ลองปรับ Code ดูเองก่อน ติดตรงไหนถามมาได้เรื่อย ๆ ครับ ผมเขียน Code สำหรับการกระจายค่าออกมาให้ดูเป็นตัวอย่างตามด้านล่าง ซึ่งดัดแปลงมาจาก http://snasui.blogspot.com/2011/06/vba.html
Code: Select all
Sub SplitThenJoin()
Dim s As String, a() As String
Dim r As Range, rAll As Range
Dim i As Integer, j As Integer, k As Integer
Call RemoveUnused
With Worksheets("Sheet1")
Set rAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
End With
For Each r In rAll
s = ""
a = Split(Right(r, Len(r) - 6), ",")
For i = 0 To UBound(a)
j = InStr(1, a(i), "-")
If IsNumeric(Left(a(i), 1)) And j > 0 Then
For k = Left(a(i), j - 1) * 100 To Mid(a(i), j + 1, 255) * 100
s = s & Left(r, 5) & "." & Format(k / 100, "0.00") & ","
Next k
End If
If Len(s) > 1 Then
a(i) = Left(s, Len(s) - 1)
Else
a(i) = Left(r, 5) & a(i) / 10
End If
Next i
s = Join(a, ",")
a = Split(s, ",")
For i = 0 To UBound(a)
a(i) = Replace(a(i), ".0", ".")
Next i
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(a) + 1) _
= Application.Transpose(a)
Next r
End Sub
ขอบคุณสำหรับคำแนะนำมากครับ เป็น Procedure ที่ผมใช้ Remove อักขระที่ไม่ใช้แล้วออกไป และมุ่งหมายให้เขียนขึ้นมาเองก่อน ผมเรียกใช้ผ่าน Procedure SplitThenJoin เพื่อสะดวกในการเรียกใช้จากการกดปุ่มเดียวแล้วทำทุกงานที่ต้องการ จะไม่นำมารวมกันก็สามารถทำได้ครับ คือ แยกเป็นตัดอักขระที่ไม่จำเป็นออกก่อน จากนั้นค่อย Generate ค่าต่าง ๆ ออกมาอาจารย์ครับผมทำได้แล้วนะครับ ตอนนี้ผมตัดตัวอักษรข้างหน้าได้ แต่ดันเหลืออักษรข้างหลัง ผมจะเอามันออกยังไงดีครับsnasui wrote: สิ่งที่ผมอยากให้คุณลองเขียนเองบ้างคือตัดค่าให้เหลือเฉพาะ E, ตัวเลข, /, -, เครื่องหมาย , (คอมม่า) และ . (จุด) เพื่อจะได้นำค่านั้นมาใช้ต่อกับ Code ด้านล่าง ซึ่งคิดว่าไม่ยากจนเกินไป อย่างน้อยก็มีผู้ช่วยเขียนมาให้ระดับหนึ่งแล้ว
จาก Link ด้านบนต้องขออภัยที่จะบอกว่า ยังคง Concept เดิมคือถามยังไม่ครบทุก ๆ เงื่อนไขที่อาจจะเป็นไปได้ครับ ต้องขอบคุณท่านเหล่านั้นที่ช่วยกันเต็มที่Code: Select all
Sub RemoveUnused()
Dim rAll As Range, r As Range
Dim t As String, v As String, u As String
Dim i As Integer, s As String
Set rAll = Sheets("Sheet1").Range("A1:A4")
For Each r In rAll
v = Left(r, 5)
u = Replace(r, v, "")
t = "0123456789,.-/"
s = ""
i = 1
Do While i <= Len(u)
If InStr(t, Mid(u, i, 1)) > 0 Then
s = s & Mid(u, i, 1)
End If
i = i + 1
Loop
r.Offset(0, 1) = v & s
Next r
End Sub
Sub SplitThenJoin()
Dim s As String, a() As String
Dim r As Range, rAll As Range
Dim i As Integer, j As Integer, k As Integer
Call RemoveUnused
With Worksheets("Sheet1")
Set rAll = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
End With
For Each r In rAll
s = ""
a = Split(Right(r, Len(r) - 6), ",")
For i = 0 To UBound(a)
j = InStr(1, a(i), "-")
If IsNumeric(Left(a(i), 1)) And j > 0 Then
For k = Left(a(i), j - 1) * 100 To Mid(a(i), j + 1, 255) * 100
s = s & Left(r, 5) & "." & Format(k / 100, "0.00") & ","
Next k
End If
If Len(s) > 1 Then
a(i) = Left(s, Len(s) - 1)
ElseIf Mid(a(i), 3, 1) = "." Then
a(i) = Left(r, 5) & "." & a(i)
Else
a(i) = Left(r, 5) & a(i) / 10
End If
Next i
s = Join(a, ",")
a = Split(s, ",")
For i = 0 To UBound(a)
a(i) = Replace(a(i), ".0", ".")
Next i
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(a) + 1) _
= Application.Transpose(a)
Next r
End Sub
Update SplitThenJoin เรียบร้อยครับ แต่ก็ยังติดปัญหาเดิมครับsnasui wrote:
นอกจากนี้ Code ที่แนบมาไม่ได้เป็น Code ล่าสุดที่ผมโพสต์ให้ไป สังเกตว่า SplitThenJoin ก็ Update เพิ่มไปให้ใหม่ครับ
ในไฟล์แนบที่ปรับ Code มาผม Run แล้วก็ได้ตามนั้นครับ