PDA

View Full Version : ช่วยแนะนำการแยกข้อมูลStringที่อยู่ในcellเดียวกันให้อยู่คนละcellหน่อยคะ



anntiant
8 May 2007, 15:03
ข้อมูลใน cell เป็นดังนี้นะคะ
mf:kinejid,part:dfe854||mf:diekdpl,part:idke4553,part:idke3455
ต้องการจะแยกข้อมูลออกมาให้อยู่คนละcellกันเป็นดังนี้ค่ะ
kinejid dfe854
diekdpl idke4553 idke3455

ช่วยแนะนำหน่อยคะว่าควรทำวิธีไหนดี ถ้าบอกcodeด้วยก็ได้นะคะ
คือว่าตอนแรกทำ TextToColumns แต่ก็ไม่ตรงกับความต้องการค่ะ

ขอบคุณมากนะคะ

สมเกียรติ
8 May 2007, 22:40
ถ้าจะใช้ VBA ต้องกำหนดเกณฑ์การแบ่งคำที่ใช้มาให้ชัดเจนด้วยครับ และยกตัวอย่างหลายๆกรณีพร้อมคำตอบที่ต้องการมาดูกันด้วย

anntiant
9 May 2007, 08:44
ถ้าจะใช้ VBA ต้องกำหนดเกณฑ์การแบ่งคำที่ใช้มาให้ชัดเจนด้วยครับ และยกตัวอย่างหลายๆกรณีพร้อมคำตอบที่ต้องการมาดูกันด้วย

หนูได้แนบไฟล์ไปให้แล้วนะคะ sheet1 คือไฟล์ master ส่วนSheet2 จะเป็นการแยกที่สำเร็จแล้ว หนูกะว่าจะใช้การจอง array ในcell ค่ะ เพราะอย่างตอนหนูใช้ TextToColumn

ถ้าเป็นตัวอย่างแรก(แถบสีเหลือง) จะสามารถใช้ TextToColumn ได้ ผลที่ได้จะได้แบบในSheet2
แต่ถ้าเป็นตัวอย่างอื่นๆ จะไม่สามารถใช้แบบวิธีแรกได้ค่ะ

รบกวนอาจารย์ช่วยแนะนำหนูด้วยนะคะว่าควรทำวิธีไหนดี
ถามอีกนิดนะคะเวลาเราใช้ TextToColumn >> Delimited ตรงที่ให้เลือก Other แล้วให้เราใส่เครื่องหมายที่ไม่มีให้เลือกในฟังก์ชันนี้แล้วถ้าเครื่องหมายที่ต้องการจะใส่มีมากกว่า 1 ละคะ
จะสามารถเขียน code ขึ้นมาเพิ่มได้มั้ยคะ

zv735
9 May 2007, 10:22
สวัสดีครับคุณanntiant

คุณ มีตัวที่ต้องตัดทิ้ง 3 ตัว คือ Mfg: Part: ||

ใช้วิธี Replace โดยเข้าไปที่ Edit ---> Replace แล้ว เลือกแทนที่ ข้อความทั้ง3 ตัว ด้วยComma(,) หรือไม่ใส่อะไรเลย ดูว่าอะไรเหมาะกว่ากันครับ

เสร็จแล้วข้อความทั้ง3หายไปแล้ว ค่อยใช้ TexttoColumn ครับ

น่าจะได้นะครับ

ขอบคุณมากครับผม

anntiant
9 May 2007, 11:14
ขอบคุณ คุณ zv735 มากนะคะที่ช่วยแนะนำมา
ลองทำดูแล้วคะ รู้สึกพบทางสว่างมาเปราะนึง
เพราะยังมีส่วนที่ต้องทำต่ออีกคะ

anntiant
10 May 2007, 08:51
สวัสดีครับคุณanntiant

คุณ มีตัวที่ต้องตัดทิ้ง 3 ตัว คือ Mfg: Part: ||

ใช้วิธี Replace โดยเข้าไปที่ Edit ---> Replace แล้ว เลือกแทนที่ ข้อความทั้ง3 ตัว ด้วยComma(,) หรือไม่ใส่อะไรเลย ดูว่าอะไรเหมาะกว่ากันครับ

เสร็จแล้วข้อความทั้ง3หายไปแล้ว ค่อยใช้ TexttoColumn ครับ

น่าจะได้นะครับ

ขอบคุณมากครับผม

ได้ทำตามที่คุณ zv735 บอกแล้วคะ คือใช้วิธี Replece ก่อน คือ Mfg: Part:
แล้วเลือกแทนที่ด้วย การไม่ต้องใส่อะไรเลย แล้วใช้ TextToColumns
แล้วใส่ Comma(,) และ || เป็นตัวแยก แต่มีปัญหาตรงที่บางข้อมูลของหนู
มี Comma(,) อยู่ในข้อความพอใช้ TextToColumns มันก็จะแยกคอลัมน์ออกมาด้วย
ใครพอมีวิธีช่วยแนะนำด้วยคะ

ขอบคุณคุณ zv735 ด้วยคะ

zv735
10 May 2007, 09:31
ที่มีปัญหา น่าจะเป็น ., ลองแทนที่ ., ด้วย { (หรือตัวที่ไม่มีในข้อความแน่แน่) ดู แล้วค่อยแยก ด้วย TexttoColumn

แล้วค่อยเปลี่ยน { กลับไปเป็น .,

น่าจะได้นะครับ

มีปัญหาตัวไหน ลอง เขียนตัวที่มีปัญหามาให้ดูด้วยก็ดีนะครับ

ขอบคุณมากครับผม

anntiant
10 May 2007, 09:56
ที่ให้ลองแทนที่ด้วย } หรืออะไรก็ได้ที่ไม่มีแน่ๆ คือให้ใช้การ Replace หรือแทนเอง(manual)เลยคะ

anntiant
10 May 2007, 10:34
ถ้าใช้ Replace Comma(,) ที่อยู่ในข้อความจะต้องเปลี่ยนตาม Replace ทั้งหมดเลยสิคะ
มีเทคนิคยังไงช่วยแนะนำหน่อยนะคะ

แต่ถ้าให้ใช้แบบ manual สามารถทำได้คะแต่พอดีข้อมูลของหนูเยอะมาก

จะทำยังไงดีคะ
ขอบคุณมากคะ

zv735
10 May 2007, 10:54
ถ้าข้อมูลที่มีปัญหาจริงๆ คือ .,(จุด+comma) ติดกัน

ก็ให้ Replace .,(จุด+comma) ติดกัน ด้วย { เลยไม่ได้หรือครับ
comma ก็จะได้ไม่เปลี่ยนครับ

ลองดู แต่ถ้าเป็นข้อมูลตัวอื่น
อาจใช้ตัวอักษรตัวหน้า Comma ร่วมด้วย เช่น C, ไปเป็น { แล้วค่อยเปลี่ยนกลับ

แต่ถ้าไม่ได้จริงๆ ลองเขียนมาดูหน่อยได้หรือเปล่าครับ
ว่าเป็นแบบไหน จะได้ช่วยกันดูนะครับ

ขอบคุณมากมากครับผม

anntiant
10 May 2007, 11:29
ลองทำแบบที่คุณzv735 แล้ว...ได้แล้วคะ
ขอบคุณมากๆคะ ถ้ามีปัญหาอะไรอีกจะถามใหม่นะคะ

ตามไฟล์ที่แนบไปให้แล้ว เกี่ยวกับการย้ายcell หลังจากแยกคอลัมน์แล้วมีวิธีไหนบ้างไหมคะ

anntiant
10 May 2007, 15:13
ลองทำ TextToColumns แล้วแต่เนื่องจากข้อมูลจริงของหนูเยอะมากคะ(คือข้อมูลในเซลล์มีแบบไม่จำกัด บางเซลล์เยอะบางเซลล์น้อย)จึงมีปัญหาในการแยกของแต่ละคอลัมน์ คือข้อมูลออกมาไม่เป็นระเบียบ ทำให้นำข้อมูลจากการใช้ TextToColumns ไปใช้ได้ยาก
จะมีวิธีอื่นอีกมั้ยคะ

ขอบคุณมากคะ

zv735
10 May 2007, 17:10
หลังจาก ที่ คุณ Replace ข้อมูลทั้งหมด แล้ว
ให้เปลี่ยน ,(Comma) และ || ของคุณ ด้วยช่องว่าง 1 ช่อง โดยใช้ Replace อีกนั้นแหละ

แล้ว ใช้ Function Trim เพื่อตัดช่องว่างที่เกินกว่า หนึ่งออก ให้เหลือช่องเดียว

โดยไปที่หน้า sheet เปล่า สมมุติเป็น Sheet4 ข้อมูลที่เปลี่ยน , Comma แล้วอยู่ที่ Sheet1 Cell A1 แล้วไล่ลงมาเรื่อยๆ

ไปที่หน้า Sheet4 ที่ Cell A1 พิมพ์

=TRIM(Sheet1!A1)

แล้วก็อบลงมาเรื่อยๆ ในหน้า Sheet4 นะ
แล้วค่อนเอาข้อมูลที่ Sheet4 ไปใช้ Texttocolumn ต่อ

แต่ถ้าข้อมูลไม่ไหวจริงๆ
ก็ยากครับผม

anntiant
11 May 2007, 16:30
ขอบคุณ คุณ zv735 มากนะคะที่มาช่วยตอบให้ตลอดเลย

หนูได้ลองทำแล้วนะคะ
โดยใช้การ Replace นำ
Mfg: >> ไม่ต้องใส่อะไรเลย
Part: >> ไม่ต้องใส่อะไรเลย
., >> ,
|| >> ,
แล้วทำ TextToColumns ใช้ Comma(,) ในการแยก
จะได้ผลออกมาตามไฟล์ที่แนบมาของ Sheet3

แต่หนูจะต้องทำออกมาแล้วให้ได้แบบ Sheet2 คะ ถ้าใครพอมีวิธีช่วยแนะนำด้วยนะคะ

ขอบคุณมากคะ

zv735
11 May 2007, 22:23
งานนี้ลำบากหละครับ :(

ไม่มีส่วนที่จะแบ่งได้เลย
คงต้องค่อยๆทำแล้วหละครับ

หรือลองดูท่านอื่นๆดูนะครับ

ขอบคุณมากมากครับ

anntiant
12 May 2007, 21:49
ขอบคุณ คุณ zv735 มากนะคะ ที่ช่วยตอบให้ตลอดเลย
จะพยายามลองทำต่อไปคะ ถ้าทำได้แล้วจะมาบอกนะคะ

ใครที่ทำได้ก็เข้ามาโพสบอกนะคะ
ขอบคุณคะ

chatchat
13 May 2007, 04:10
คุณ anntiant ใช้ VBA ได้ใช้มั้ยครับ :)

ตามความต้องการของคุณนั้น ผมใช้ฟังก์ชั่นเกี่ยวกับการค้นหาตำแหน่ง ใน string ตามเงื่อนไขแล้วจัดการแบ่งข้อความ ลงใน cell ที่ต้องการ ลองดูตามไฟล์แนบนะครับ
สงสัย code ตรงส่วนไหน สอบถามได้นะครับ :) เนื่องจากมีการวนลูปไว้ค่อนข้างเยอะ


Option Explicit
Sub Septext()
Dim a As String
Dim ccStr, cRo, startText As Integer
Dim cMfg As Integer
Dim countaTxt As Integer
Dim bb, cc As Integer
cRo = 1
countaTxt = 1
startText = 1
Sheets("Sheet2").Select
Columns("A:B").Select
Selection.ClearContents
Range("A1").Select
Do

a = Worksheets("sheet1").Cells(countaTxt, 1).Value


If InStr(startText + 1, a, "||", vbTextCompare) = 0 Then ' If not Found ||
'====================================================

bb = InStr(startText, a, "Part:", vbTextCompare)
cc = InStr(startText + bb, a, "Part:", vbTextCompare)
Do
If cc = 0 Then ' cc
cc = Len(a)
' startText = 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, 2).Value = Mid(a, bb + 5, Len(a) - bb) 'Part string
cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '1
'Exit Sub
'startText = 1
Else: End If ' 1

Else
' cRo = cRo + 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, 2).Value = Mid(a, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '2
' Exit Do
'startText = 1
Else: End If '2
bb = cc
cc = 0

End If ' cc

Loop While cc = 0

'====================================================

Else 'Found ||

'====================================================
Dim aPos As Integer
Dim cPos As Integer
Dim txtStart As Integer
Dim aStr As String
txtStart = 1
cPos = 1

Do

aPos = InStr(txtStart, a, "||")
If aPos = 0 Then
'*******************

aStr = Right(a, Len(a) - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)

If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1
txtStart = 1
Else
txtStart = 1
End If ' 1
Else
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2

End If ' cc
'*******************

Else

'*******************

aStr = Mid(a, txtStart, aPos - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)
Do
If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string

cRo = cRo + 1

startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1

Else: End If ' 1
Else

If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
txtStart = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2
bb = cc
cc = 0
End If ' cc

Loop While cc = 0

'*******************
End If
txtStart = aPos + 1

Loop While aPos > 0


'====================================================
End If 'mfg:
countaTxt = countaTxt + 1

startText = 1
Loop Until Worksheets("sheet1").Cells(countaTxt, 1).Value = ""

End Sub

anntiant
13 May 2007, 09:58
ขอบคุณมากนะคะ สำหรับ VBA นับถือจริงๆคะ
ถ้าหนูจะทำใ้ห้สามารถใช้ได้กับทุกไฟล์ควรใช้อะไรดีคะ เพราะถ้าแบบ button ก็จะใช้ได้แค่ไฟล์นี้ไฟล์เดียว ใช่มั้ยคะ

นัท
13 May 2007, 12:20
ขอบคุณมากนะคะ สำหรับ VBA นับถือจริงๆคะ
ถ้าหนูจะทำใ้ห้สามารถใช้ได้กับทุกไฟล์ควรใช้อะไรดีคะ เพราะถ้าแบบ button ก็จะใช้ได้แค่ไฟล์นี้ไฟล์เดียว ใช่มั้ยคะ


แนะนำให้นำโค้ดดังกล่าวทำเป็นแฟ้มแอดอินส์ครับ ลองอ่านวิธีการทำแฟ้มแอดอินส์ที่

http://www.excelexperttraining.com/general/addin.html
http://www.excelexperttraining.com/blog/archives/z300-ExcelCore39.php

anntiant
13 May 2007, 22:20
ขอบคุณ คุณ นัท มากนะคะ จะลองทำดูก่อนคะ

anntiant
14 May 2007, 09:06
ไม่รุ้ว่าหนูจะถามมากไปมั้ยนะคะ แต่ไม่รู้จะทำวิธีไหนจริงๆ ต้องรบกวนผู้รู้อย่างพี่ๆช่วยหนูหน่อยคะ

ถ้าไฟล์จริงๆมีข้อมูลมากกว่า 1 คอลัมน์ (ที่แนบไฟล์ไปมีแค่ 1 คอลัมน์)
คือหนูจะให้คอลัมน์ของ sheet 1 อยู่ใน sheet2 ด้วย แต่ sheet2 จะต้องเพิ่มมาอีก 1 คอลัมน์ คือ คอลัมน์ที่ถูกแยกออกมา
ส่วน row ก็จะให้เพิ่มบรรทัดออกมาตามที่ถูกแยกมาด้วยคะ
หนูแนบไฟล์ตัวอย่าง ให้ดูด้วยนะคะ

รบกวนอีกครั้งคะ
ขอบคุณมากคะ

rundim
14 May 2007, 14:43
ลองดูไฟล์ที่แนบมา ว่าใช้กับที่ต้องการหรือป่าวครับ
ลองปรับแต่งเพิ่มเติมอีกนะครับเพราะว่า ทำให้เท่าที่ถามนะครับ:)

anntiant
14 May 2007, 15:40
จาก code ที่คุณ chatchat ให้มา
ถ้าสมมติว่า part: มีมากกว่า 2 ในแต่ละเซลล์ มีมากกว่า 2 ละคะ จะใส่ code ยังไงดี

ขอบคุณ คุณ rundim มากคะ

zv735
14 May 2007, 15:43
รหัสของคุณ chatchat ก็ใช้ได้แล้วหนิครับ
ปรับแก้ไม่กี่บรรทัดเองหนิครับ
ลองดู Code ข้างล่างนะครับ



Option Explicit
Sub Septext()
Dim a As String
Dim ccStr, cRo, startText As Integer, cRowTxt As Integer
Dim cMfg As Integer
Dim countaTxt As Integer
Dim bb, cc As Integer
cRo = 2 'เพิ่มอีก1 เพราะมี หัว Column
cRowTxt = 2 'Cells(cRo, 1) ไปเป็น Cells(cRo, CRowTxt) และ Cells(cRo, 2) ไปเป็น Cells(cRo, CRowTxt+1)
'Text ที่จะเปลี่ยนอยู่ไหนก็ให้ใส่เลขนั้น ในที่นี้อยู่ Column 2
countaTxt = 2 'เพิ่มอีก1 เพราะมี หัว Column
startText = 1
Sheets("Sheet2").Select
Range("A2:D65536").Select
Selection.ClearContents
Range("A1").Select
Do
Sheet2.Cells(cRo, cRowTxt-1) = Sheet1.Cells(countaTxt, 1) 'ใส่เลขรหัสข้างหน้า
Sheet2.Cells(cRo, cRowTxt+2) = Sheet1.Cells(countaTxt, 3) 'ใส่เลขรหัสข้างหลัง
a = Worksheets("sheet1").Cells(countaTxt, cRowTxt).Value


If InStr(startText + 1, a, "||", vbTextCompare) = 0 Then ' If not Found ||
'====================================================

bb = InStr(startText, a, "Part:", vbTextCompare)
cc = InStr(startText + bb, a, "Part:", vbTextCompare)
Do
If cc = 0 Then ' cc
cc = Len(a)
' startText = 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(a, bb + 5, Len(a) - bb) 'Part string
cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '1
'Exit Sub
'startText = 1
Else: End If ' 1

Else
' cRo = cRo + 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(a, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '2
' Exit Do
'startText = 1
Else: End If '2
bb = cc
cc = 0

End If ' cc

Loop While cc = 0

'====================================================

Else 'Found ||

'====================================================
Dim aPos As Integer
Dim cPos As Integer
Dim txtStart As Integer
Dim aStr As String
txtStart = 1
cPos = 1

Do

aPos = InStr(txtStart, a, "||")
If aPos = 0 Then
'*******************

aStr = Right(a, Len(a) - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)

If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1
txtStart = 1
Else
txtStart = 1
End If ' 1
Else
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2

End If ' cc
'*******************

Else

'*******************

aStr = Mid(a, txtStart, aPos - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)
Do
If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string

cRo = cRo + 1

startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1

Else: End If ' 1
Else

If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
txtStart = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2
bb = cc
cc = 0
End If ' cc

Loop While cc = 0

'*******************
End If
txtStart = aPos + 1

Loop While aPos > 0


'====================================================
End If 'mfg:
countaTxt = countaTxt + 1

startText = 1
Loop Until Worksheets("sheet1").Cells(countaTxt, 1).Value = ""

End Sub


ลองดู File แนบประกอบนะครับ

anntiant
14 May 2007, 15:56
ใช้ที่คุณ chatchat ให้มาก็จะได้แล้วคะ
แต่หนูติดตรงที่ ถ้ามีบางเซลล์มี part มากกว่า 2 part จะไม่ขึ้นบรรทัดใหม่ให้คะ
ตามไฟล์แนบคะ
ขอบคุณคะ

rundim
14 May 2007, 16:22
Range("B1").Select
Cells.Replace What:="||Mfg:", Replacement:="[$[", LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:="Mfg:", Replacement:="$[", LookAt:=xlPart, SearchOrder:=xlByRows
Cells.Replace What:=",Part:", Replacement:=";&;", LookAt:=xlPart, SearchOrder:=xlByRows
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Semicolon:=True, Other:=True, OtherChar:="[", FieldInfo:=Array(Array(1, 1), 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)), TrailingMinusNumbers:=True

จาก code ขอผมนะครับ
แค่เปลี่ยนจาก * เป็น [ หรือตัวอื่นที่ไม่เกี่ยวข้องก็ได้ครับ แค่ 3 ที่เท่านั้นก็ได้แล้วครับ

anntiant
14 May 2007, 16:47
ขอบคุณ คุณ rundim มากคะ จะลองเอาไปใช้ดู
แล้วถ้าเป็น code ของคุณ chatchat ละคะ ที่หนูดู หนูว่าน่าจะใช้ loop เพิ่มเข้ามา
แต่ไม่แน่ใจคะ ช่วยบอกหน่อยคะว่าควรใส่อะไรเพิ่มคะ

แล้ว aStr = Right(a, Len(a) - txtStart) ที่อยู่ใน code หมายความว่ายังไงคะ
txtStart = 1 ใช่มั้ยคะ

anntiant
15 May 2007, 09:31
ถ้าจะให้โปรแกรมเช็คว่า ถ้าคอลัมน์ A มีข้อมูลและคอลัมน์ B ไม่มีข้อมูล ให้ขึ้น msgBox ว่าให้กรอกข้อมูลให้ครบ แล้วให้ตัวที่ชี้ cell (ที่เป็นกรอบสี่เหลี่ยม) ไปชี้ที่ cell ที่ว่าง ที่อยู่ cell 1
ช่วยดูให้หน่อยคะว่าควรใส่ยังไงดี
Sheets("Sheet1").Select
Range(???).Select --> ??? ควรเป็นอะไรคะ


ขอบคุณคะ

anntiant
15 May 2007, 10:34
ไม่ใช่ว่า code ของคุณ rundim ใช้ไม่ได้นะคะ แต่พอดีหนูถนัดดู code แบบคุณ chatchat มากกว่าหนะคะ
>> code ของคุณ rundim ดูแล้วสั้นกว่าด้วย
ขอบคุณมากนะคะ

zv735
15 May 2007, 11:21
a = Worksheets("sheet1").Cells(countaTxt, cRowTxt).Value
ค่า a รับค่ามาจาก Cells(countaTxt, cRowTxt).Value
ก็ควรใช้ Cells(countaTxt, cRowTxt).Select
จะให้ Cell อยู่ที่ Column ไหน ก็เปลี่ยนที่ cRowTxt ครับ
อยู่ Column A ก็ใช้ Cells(countaTxt, 1).Select
If a = "" Then
MsgBox "¡ÃسҡÃ
Í¡¢éÍÁÙÅãËé¤Ãº", vbOKOnly
'Sheet2.Cells.Select
'Selection.ClearContents
Sheets("Sheet1").Select
Cells(countaTxt, 1).Select
Exit Do
Exit Sub
End If

anntiant
15 May 2007, 11:40
ได้แล้วคะ ขอบคุณ คุณ zv735 มากนะคะ

ขอถามหน่อยคะว่า ถ้าจะนับ กลุ่มข้อความ ที่อยู่ cell ว่ามีกี่กลุ่ม เขียน code ว่ายังไงคะ
เช่น จะดูว่า "part:" มีกี่ตัว

rundim
15 May 2007, 12:01
ได้แล้วคะ ขอบคุณ คุณ zv735 มากนะคะ

ขอถามหน่อยคะว่า ถ้าจะนับ กลุ่มข้อความ ที่อยู่ cell ว่ามีกี่กลุ่ม เขียน code ว่ายังไงคะ
เช่น จะดูว่า "part:" มีกี่ตัว

ผมยังตีความหมายยังไม่เข้าใจนะครับ
ว่าจะนับตาม Item number หรือ Mfg หรือ นับ Part ทั้งหมดรวมเลย หรือว่าแยกกัน:)
ยกตัวอย่างก้อดีนะครับ

anntiant
15 May 2007, 13:04
ผมยังตีความหมายยังไม่เข้าใจนะครับ
ว่าจะนับตาม Item number หรือ Mfg หรือ นับ Part ทั้งหมดรวมเลย หรือว่าแยกกัน:)
ยกตัวอย่างก้อดีนะครับ
นับ part: ในช่อง Mfg ของ Sheet1 คะ ว่า 1 mfg มี part กี่ตัว
เช่น Mfg:lidleid,Part:GRM155F51C104ZA01D,Part:GRM36Y5V104Z016AQ,Part:GRP155F51C104ZA01E
มี part 3 ตัว

anntiant
15 May 2007, 14:23
คุณ anntiant ใช้ VBA ได้ใช้มั้ยครับ :)

ตามความต้องการของคุณนั้น ผมใช้ฟังก์ชั่นเกี่ยวกับการค้นหาตำแหน่ง ใน string ตามเงื่อนไขแล้วจัดการแบ่งข้อความ ลงใน cell ที่ต้องการ ลองดูตามไฟล์แนบนะครับ
สงสัย code ตรงส่วนไหน สอบถามได้นะครับ :) เนื่องจากมีการวนลูปไว้ค่อนข้างเยอะ


Option Explicit
Sub Septext()
Dim a As String
Dim ccStr, cRo, startText As Integer
Dim cMfg As Integer
Dim countaTxt As Integer
Dim bb, cc As Integer
cRo = 1
countaTxt = 1
startText = 1
Sheets("Sheet2").Select
Columns("A:B").Select
Selection.ClearContents
Range("A1").Select
Do

a = Worksheets("sheet1").Cells(countaTxt, 1).Value


If InStr(startText + 1, a, "||", vbTextCompare) = 0 Then ' If not Found ||
'====================================================
ส่วนนี้เข้าใจแล้วคะ
'====================================================

Else 'Found ||
ส่วนนี้ไม่ค่อยเข้าใจ ช่วยอธิบายหน่อยคะ '====================================================
Dim aPos As Integer
Dim cPos As Integer
Dim txtStart As Integer
Dim aStr As String
txtStart = 1
cPos = 1

Do

aPos = InStr(txtStart, a, "||")
If aPos = 0 Then
'*******************

aStr = Right(a, Len(a) - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)

If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1
txtStart = 1
Else
txtStart = 1
End If ' 1
Else
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2

End If ' cc
'*******************

Else

'*******************

aStr = Mid(a, txtStart, aPos - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)
Do
If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string

cRo = cRo + 1

startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1

Else: End If ' 1
Else

If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, 1).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, 2).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
cRo = cRo + 1
txtStart = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2
bb = cc
cc = 0
End If ' cc

Loop While cc = 0

'*******************
End If
txtStart = aPos + 1

Loop While aPos > 0


'====================================================
End If 'mfg:
countaTxt = countaTxt + 1

startText = 1
Loop Until Worksheets("sheet1").Cells(countaTxt, 1).Value = ""

End Sub

ช่วยอธิบาย code ตั้งแต่ส่วนที่มี || หน่อยคะ ไม่ค่อยเข้าใจ
โดยเฉพาะการนำ aPos , cPos , aStr , txtStart
เข้ามา เพื่อทำอะไรคะ?? งงมากมาย

rundim
15 May 2007, 14:48
Option Explicit
Sub Septext()
Dim a As String
Dim ccStr, cRo, startText, cRowTxt As Integer
Dim cMfg As Integer
Dim countaTxt As Integer
Dim bb, cc, dd As Integer '<<
cRo = 2
countaTxt = 2
cRowTxt = 2
startText = 1
Sheets("Sheet2").Select
Cells.Clear
Selection.HorizontalAlignment = xlLeft
Range("A1").Select
ActiveCell.FormulaR1C1 = "Item number"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Mfg"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Part"
Range("D1").Select
Do
Sheet2.Cells(cRo, cRowTxt - 1) = Sheet1.Cells(countaTxt, 1) '&atilde;&Ecirc;&egrave;&agrave;&Aring;&cent;&Atilde;&Euml;&Ntilde;&Ecirc;&cent;&eacute;&Ograve;&sect;&Euml;&sup1;&eacute;&Ograve;
a = Sheet1.Cells(countaTxt, cRowTxt).Value
If a = "" Then ' check &Ccedil;&egrave;&Ograve; cell &auml;&Euml;&sup1;&atilde;&sup1;column B &Ccedil;&egrave;&Ograve;&ordm;&eacute;&Ograve;&sect;
MsgBox "&iexcl;&Atilde;&Oslash;&sup3;&Ograve;&iexcl;&Atilde;&Iacute;&iexcl;&cent;&eacute;&Iacute;&Aacute;&Ugrave;&Aring;&atilde;&Euml;&eacute;&curren;&Atilde;&ordm;", vbOKOnly
Sheets("Sheet1").Select: Cells(countaTxt, cRowTxt).Select
Exit Sub
End If
If InStr(startText + 1, a, "||", vbTextCompare) = 0 Then ' If not Found ||
'====================================================

bb = InStr(startText, a, "Part:", vbTextCompare)
cc = InStr(startText + bb, a, "Part:", vbTextCompare)
Do
If bb = 0 Then '&para;&eacute;&Ograve;&Aacute;&Otilde;&aacute;&micro;&egrave; mfg(&auml;&Aacute;&egrave;&Aacute;&Otilde;part) &atilde;&Euml;&eacute; blank &auml;&Ccedil;&eacute;
cc = Len(a)
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, cc - 4) 'MFG:
cRo = cRo + 1
ElseIf cc = 0 Then ' cc
cc = Len(a)
' startText = 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(a, bb + 5, Len(a) - bb) 'Part string

dd = dd + 1 '<<เพิ่มตัวนับการวนloop ของทุก Part string


cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '1
'Exit Sub
'startText = 1
Else: End If ' 1

Else
' cRo = cRo + 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(a, bb + 5, cc - (bb + 6)) 'Part string
dd = dd + 1
cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '2
' Exit Do
'startText = 1
Else: End If '2
bb = cc
cc = 0

End If ' cc

Loop While cc = 0

'====================================================

Else 'Found ||

'====================================================
Dim aPos As Integer
Dim cPos As Integer
Dim txtStart As Integer
Dim aStr As String
txtStart = 1
cPos = 1

Do

aPos = InStr(txtStart, a, "||")
If aPos = 0 Then
'*******************

aStr = Right(a, Len(a) - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)

If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string
dd = dd + 1
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1
txtStart = 1
Else
txtStart = 1
End If ' 1
Else
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
dd = dd + 1
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2

End If ' cc
'*******************

Else

'*******************

aStr = Mid(a, txtStart, aPos - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)
Do
If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string
dd = dd + 1
cRo = cRo + 1

startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1

Else: End If ' 1
Else

If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
dd = dd + 1
cRo = cRo + 1
txtStart = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2
bb = cc
cc = 0
End If ' cc

Loop While cc = 0

'*******************
End If
txtStart = aPos + 1
MsgBox dd, vbOKOnly '<< แสดงผลนับ
dd = 0 '<<เริ่มการนับใหม่
Loop While aPos > 0


'====================================================
End If 'mfg:
countaTxt = countaTxt + 1

startText = 1
Loop Until Worksheets("sheet1").Cells(countaTxt, 1).Value = ""

End Sub



ลองตรวจสอบดูอีกทีนะครับ:)

anntiant
15 May 2007, 15:34
Option Explicit
Sub Septext()
Dim a As String
Dim ccStr, cRo, startText, cRowTxt As Integer
Dim cMfg As Integer
Dim countaTxt As Integer
Dim bb, cc, dd As Integer '<<
cRo = 2
countaTxt = 2
cRowTxt = 2
startText = 1
Sheets("Sheet2").Select
Cells.Clear
Selection.HorizontalAlignment = xlLeft
Range("A1").Select
ActiveCell.FormulaR1C1 = "Item number"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Mfg"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Part"
Range("D1").Select
Do
Sheet2.Cells(cRo, cRowTxt - 1) = Sheet1.Cells(countaTxt, 1) '&atilde;&Ecirc;&egrave;&agrave;&Aring;&cent;&Atilde;&Euml;&Ntilde;&Ecirc;&cent;&eacute;&Ograve;&sect;&Euml;&sup1;&eacute;&Ograve;
a = Sheet1.Cells(countaTxt, cRowTxt).Value
If a = "" Then ' check &Ccedil;&egrave;&Ograve; cell &auml;&Euml;&sup1;&atilde;&sup1;column B &Ccedil;&egrave;&Ograve;&ordm;&eacute;&Ograve;&sect;
MsgBox "&iexcl;&Atilde;&Oslash;&sup3;&Ograve;&iexcl;&Atilde;&Iacute;&iexcl;&cent;&eacute;&Iacute;&Aacute;&Ugrave;&Aring;&atilde;&Euml;&eacute;&curren;&Atilde;&ordm;", vbOKOnly
Sheets("Sheet1").Select: Cells(countaTxt, cRowTxt).Select
Exit Sub
End If
If InStr(startText + 1, a, "||", vbTextCompare) = 0 Then ' If not Found ||
'====================================================

bb = InStr(startText, a, "Part:", vbTextCompare)
cc = InStr(startText + bb, a, "Part:", vbTextCompare)
Do
If bb = 0 Then '&para;&eacute;&Ograve;&Aacute;&Otilde;&aacute;&micro;&egrave; mfg(&auml;&Aacute;&egrave;&Aacute;&Otilde;part) &atilde;&Euml;&eacute; blank &auml;&Ccedil;&eacute;
cc = Len(a)
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, cc - 4) 'MFG:
cRo = cRo + 1
ElseIf cc = 0 Then ' cc
cc = Len(a)
' startText = 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(a, bb + 5, Len(a) - bb) 'Part string

dd = dd + 1 '<<เพิ่มตัวนับการวนloop ของทุก Part string


cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '1
'Exit Sub
'startText = 1
Else: End If ' 1

Else
' cRo = cRo + 1
If startText = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(a, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(a, bb + 5, cc - (bb + 6)) 'Part string
dd = dd + 1
cRo = cRo + 1
startText = InStr(startText, a, "Part:", vbTextCompare) + 1
If InStr(startText, a, "Part:", vbTextCompare) = 0 Then '2
' Exit Do
'startText = 1
Else: End If '2
bb = cc
cc = 0

End If ' cc

Loop While cc = 0

'====================================================

Else 'Found ||

'====================================================
Dim aPos As Integer
Dim cPos As Integer
Dim txtStart As Integer
Dim aStr As String
txtStart = 1
cPos = 1

Do

aPos = InStr(txtStart, a, "||")
If aPos = 0 Then
'*******************

aStr = Right(a, Len(a) - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)

If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string
dd = dd + 1
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1
txtStart = 1
Else
txtStart = 1
End If ' 1
Else
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
dd = dd + 1
cRo = cRo + 1
startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2

End If ' cc
'*******************

Else

'*******************

aStr = Mid(a, txtStart, aPos - txtStart)
txtStart = 1
bb = InStr(txtStart, aStr, "Part:", vbTextCompare)
cc = InStr(txtStart + bb, aStr, "Part:", vbTextCompare)
Do
If cc = 0 Then ' cc
cc = Len(aStr)
If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If

Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, Len(aStr) - bb) 'Part string
dd = dd + 1
cRo = cRo + 1

startText = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '1

Else: End If ' 1
Else

If txtStart = 1 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = Mid(aStr, 5, bb - 6) 'MFG:
Else: End If
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = Mid(aStr, bb + 5, cc - (bb + 6)) 'Part string
dd = dd + 1
cRo = cRo + 1
txtStart = InStr(txtStart, aStr, "Part:", vbTextCompare) + 1
If InStr(txtStart, aStr, "Part:", vbTextCompare) = 0 Then '2
Exit Sub
Else: End If '2
bb = cc
cc = 0
End If ' cc

Loop While cc = 0

'*******************
End If
txtStart = aPos + 1
MsgBox dd, vbOKOnly '<< แสดงผลนับ
dd = 0 '<<เริ่มการนับใหม่
Loop While aPos > 0


'====================================================
End If 'mfg:
countaTxt = countaTxt + 1

startText = 1
Loop Until Worksheets("sheet1").Cells(countaTxt, 1).Value = ""

End Sub



ลองตรวจสอบดูอีกทีนะครับ:)

จากที่คุณ rundim ใส่ code ให้นับ part ได้ จะนับได้ถูก ก็ต่อเมื่อ ใน 1 mfg มี part ไม่เกิน 2 ตัว (แต่ทำแบบนับนี้แล้วรู้สึกว่ามันไม่ตรงกับที่หนูต้องการทำเลยคะ)

ช่วยหนูหน่อยคะว่าควรจะใส่ code อะไรเพิ่มเพื่อให้แยก part ที่มีมากกว่า 2 สามารถแยกแล้วให้ขึ้นบรรทัดใหม่ใน คอลัมน์ part ใน sheet 2
จากไฟล์แนบ (จริงๆเคยแนบให้แล้วแต่ยังไม่มีใครช่วยตอบคำถามนี้นี้เลยคะ)
ดูตรงแถบสีเหลืองนะคะ โปรแกรมทำออกมาแล้วได้แบบ Sheet2 แต่อยากให้ออกมาแบบ Sheet3 คะ

ขอบคุณคะ

สมเกียรติ
15 May 2007, 15:50
ถ้าจะใช้ VBA ต้องกำหนดเกณฑ์การแบ่งคำที่ใช้มาให้ชัดเจนด้วยครับ และยกตัวอย่างหลายๆกรณีพร้อมคำตอบที่ต้องการมาดูกันด้วย

ดูตัวอย่างที่ถามกันแล้ว ต้องการแยกคำที่อยู่ระหว่างเครื่องหมาย : , || ใช่ไหมครับ
ถ้าใช่ ปัญหานี้ใช้สูตร Trim + Substitute เพื่อจัดการปรับคำให้เป็นมาตรฐานก่อน
จากนั้นใช้สูตร Find หาตำแหน่งของ : และ ,
แล้วใช้สูตร Mid แยกคำออกมา

ปัญหาที่ถามมานี้ เกิดจากงานอะไรครับ จะเอาคำตอบไปทำอะไรต่อ เป็นการบ้านส่งใครหรือ

anntiant
15 May 2007, 16:01
ดูตัวอย่างที่ถามกันแล้ว ต้องการแยกคำที่อยู่ระหว่างเครื่องหมาย : , || ใช่ไหมครับ
ถ้าใช่ ปัญหานี้ใช้สูตร Trim + Substitute เพื่อจัดการปรับคำให้เป็นมาตรฐานก่อน
จากนั้นใช้สูตร Find หาตำแหน่งของ : และ ,
แล้วใช้สูตร Mid แยกคำออกมา

ปัญหาที่ถามมานี้ เกิดจากงานอะไรครับ จะเอาคำตอบไปทำอะไรต่อ เป็นการบ้านส่งใครหรือ
ขอบคุณอาจารย์มากคะ
ปัญหาที่ถามเป็นส่วนหนึ่งของโปรเจ็คคะ

zv735
15 May 2007, 23:59
ที่ต้องการนับ part เพื่อแยกให้ครบใช่หรือเปล่าครับ

ถ้าใช้ Code ของคุณ rundim
ไม่ต้องแก้ไขอะไรเลยก็ใช้ได้แล้วหนิครับ
เพิ่มส่วนการเติมตัวเลขหน้ากับหลัง ก็ถูกต้องทั้งหมดแล้วครับผม

Sheet2.Cells(Count$, 1) = Sheet1.Cells(Range(c).Row, 1) 'เติมตัวเลข no
Sheet2.Cells(Count$, 4) = Sheet1.Cells(Range(c).Row, 3) 'เติมตัวเลข allo

ดู File แนบนะครับ

chatchat
16 May 2007, 07:30
สวัสดีครับ

หายไปหลายวัน เข้ามาดูอีกที ไม่คิดว่าจะ reply เยอะขนาดนี้
ผมย้อนกลับไป คำถามของคุณ anntiant เข้าใจว่าในโจทย์ มี part แค่ 1 กับ 2 เท่านั้น ผมเลยใช้ if then else ธรรมดา ส่วนถ้าจะให้ work จริงๆ ก็ของคุณ rundim ครับ

anntiant
16 May 2007, 09:07
สวัสดีครับ

หายไปหลายวัน เข้ามาดูอีกที ไม่คิดว่าจะ reply เยอะขนาดนี้
ผมย้อนกลับไป คำถามของคุณ anntiant เข้าใจว่าในโจทย์ มี part แค่ 1 กับ 2 เท่านั้น ผมเลยใช้ if then else ธรรมดา ส่วนถ้าจะให้ work จริงๆ ก็ของคุณ rundim ครับ

แล้วถ้าจะใช้ code ของคุณ chatchat เขียนให้ออกมาเหมือนของคุณ rundim จะเป็นไปได้มั้ยถ้าทำได้ จะต้องใช้ code ยังไงคะ

rundim
16 May 2007, 11:07
ดูแล้วสามารถทำได้ครับ
เดี๋ยวจะลองแก้ให้ดูนะครับ ถ้ามีเวลาว่างนะครับ:D

anntiant
16 May 2007, 11:27
ดูแล้วสามารถทำได้ครับ
เดี๋ยวจะลองแก้ให้ดูนะครับ ถ้ามีเวลาว่างนะครับ:D

รบกวนหน่อยนะคะ
ขอบคุณมากคะ

chatchat
16 May 2007, 14:41
สวัสดีครับ

ผม coding ให้ใหม่หมดเลยนะ จากเดิมดูแค่ 2 part เปลี่ยนเป็นวนลูปเช็คทั้งข้อความ แล้วตัดมาเรียงที่ cell ใหม่
ให้ผลลัพธ์เหมือนของคุณrundim แต่จะประมวลผลเร็วกว่า กรณีที่ source มีจำนวนมากๆ และ code ก็น่าจะ็ดูเข้าใจง่ายนะครับ ;)


Sub Macro()
Sheet2.Range("A2:D65536").ClearContents
Dim a, bb, posMfg, posPart, c, posPartEnd, Ro, RoPart, RoMfg As Integer
Dim txtMfg, txtPart, cutText, ExText As String
Ro = 3
RoPart = 2
RoMfg = 2
Do
ExText = Worksheets("sheet1").Cells(Ro, 2).Text & "|||"
Worksheets("sheet2").Cells(RoMfg, 1).Value = Worksheets("sheet1").Cells(Ro, 1).Value
Worksheets("sheet2").Cells(RoMfg, 4).Value = Worksheets("sheet1").Cells(Ro, 3).Value
a = Len(ExText)
For bb = 1 To a
posMfg = InStr(bb + 1, ExText, "Mfg:", vbTextCompare) ' &#203;&#210;&#181;&#211;&#225;&#203;&#185;&#232;&#167;&#162;&#205;&#167; Mfg:
If posMfg = 0 Then
posMfg = Len(ExText)
Else: End If
For c = 1 To posMfg
If bb = 1 Then
cutText = Mid(ExText, bb, posMfg - 3)
Else
cutText = Mid(ExText, bb - 1, posMfg - (bb + 1))
End If
posPart = InStr(c, cutText, "Part:", vbTextCompare) '12
c = c + posPart
posPartEnd = InStr(c, cutText, "Part:", vbTextCompare) '36
If posPartEnd = 0 Then
txtPart = Mid(cutText, posPart + 5, Len(cutText) - (posPart))
Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
RoPart = RoPart + 1
Exit For 'c
Else 'part &#181;&#209;&#199;&#202;&#216;&#180;&#183;&#233;&#210;&#194;&#225;&#197;&#233;&#199;
txtPart = Mid(cutText, posPart + 5, posPartEnd - posPart - 6)
Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
RoPart = RoPart + 1
End If
Next c
txtMfg = Mid(cutText, 5, InStr(1, cutText, "Part:", vbTextCompare) - 6) '&#225;&#202;&#180;&#167;&#170;&#215;&#232;&#205; Mfg:
Worksheets("sheet2").Cells(RoMfg, 2).Value = txtMfg

RoMfg = RoMfg + (RoPart - RoMfg)
bb = posMfg
Next bb
Ro = Ro + 1
Loop Until Worksheets("sheet1").Cells(Ro, 2).Text = ""
Worksheets("sheet2").Select
End Sub

anntiant
16 May 2007, 14:58
ขอบคุณ คุณ chatchat มากนะคะ สุดยอดจริงๆคะ
แต่หนูลองใส่ข้อมูลที่มี part มากกว่า 3 คือตั้งแต่ 4 ขึ้นไปแล้วมันจะขึ้น cell ใหม่คะ
code เดิมก็เหมือนกัน( พอดีลองใส่ loop ใหม่ใน code ของคุณแล้ว ผลที่ออกมาคือ
ถ้ามี part 3 ตัวก็จะเรียงได้ แต่ถ้ามี 4 ตัวขึ้นไป part ตัวต่อไปก็จะต่อ part ตัวที่ 3คะ
ไม่ขึ้นบรรทัดใหม่)
คือข้อมูลจริงของหนู mfg และ part จะมีไม่จำกัดหนะคะ

แล้วถ้าต้องทำให้เป็น Function ต้องกำหนดตัวแปรยังไงคะ ช่วยสอนหน่อย จะเอาไปทำเป็น
add ins คะ

rundim
16 May 2007, 15:44
Option Explicit
Sub Septext()
Dim a, b, c, d, e, f, g As String
Dim ccStr, cRo, startText, cRowTxt As Integer
Dim cMfg As Integer
Dim countaTxt As Integer
Dim bb, cc, dd As Integer
cRo = 2
countaTxt = 2
cRowTxt = 2
startText = 1
Sheets("Sheet2").Select
Cells.Clear
Cells.HorizontalAlignment = xlLeft
Range("A1").Value = "Item number"
Range("B1").Value = "Mfg"
Range("C1").Value = "Part"
Do
Sheet2.Cells(cRo, cRowTxt - 1) = Sheet1.Cells(countaTxt, 1) '&atilde;&Ecirc;&egrave;&agrave;&Aring;&cent;&Atilde;&Euml;&Ntilde;&Ecirc;&cent;&eacute;&Ograve;&sect;&Euml;&sup1;&eacute;&Ograve;
a = Worksheets("sheet1").Cells(countaTxt, cRowTxt).Value
b = InStr(1, a, ":", vbTextCompare)
c = Worksheets("Sheet1").Cells(countaTxt, cRowTxt).Characters.Count
a = Mid(a, b + 1, c - b)
d = InStr(1, a, "part:", vbTextCompare)
If d = 0 Then GoTo finish2
f = Mid(a, 1, d - 2)
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f
'====================================================
Do
Do

b = InStr(1, a, ",part:", vbTextCompare)
a = Mid(a, b + 6, c - b)
d = InStr(1, a, "||Mfg:", vbTextCompare)
b = InStr(1, a, ",part:", vbTextCompare)
If d = 0 And b = 0 Then GoTo finish
f = Mid(a, 1, b - 1)
g = InStr(1, f, "Mfg:", vbTextCompare)
'*******************

If g = 0 Then
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
cRo = cRo + 1
Else: End If

Loop While g = 0
f = Mid(f, 1, d - 1)
g = InStr(1, f, "Mfg:", vbTextCompare)
'*******************

If g = 0 Then
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
cRo = cRo + 1
Else: End If



Do
b = InStr(1, a, "||Mfg:", vbTextCompare)
a = Mid(a, b + 6, c - b)
d = InStr(1, a, ",part:", vbTextCompare)
b = InStr(1, a, "||Mfg:", vbTextCompare)
f = Mid(a, 1, d - 1)
g = InStr(1, f, ",part:", vbTextCompare)
If g = 0 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f 'Mfg
Else: End If
Loop While g <> 0
Loop While g = 0
finish:
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = a 'Part string
cRo = cRo + 1
countaTxt = countaTxt + 1: GoTo out
finish2:
MsgBox "&auml;&Aacute;&egrave;&Aacute;&Otilde; Part", vbOKOnly
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = a
cRo = cRo + 1
countaTxt = countaTxt + 1
out:
Loop Until Sheet1.Cells(countaTxt, 1) = ""
End Sub



ช่วยลอง test Code นี้หน่อยนะครับ :)

anntiant
16 May 2007, 16:29
Option Explicit
Sub Septext()
Dim a, b, c, d, e, f, g As String
Dim ccStr, cRo, startText, cRowTxt As Integer
Dim cMfg As Integer
Dim countaTxt As Integer
Dim bb, cc, dd As Integer
cRo = 2
countaTxt = 2
cRowTxt = 2
startText = 1
Sheets("Sheet2").Select
Cells.Clear
Cells.HorizontalAlignment = xlLeft
Range("A1").Value = "Item number"
Range("B1").Value = "Mfg"
Range("C1").Value = "Part"
Do
Sheet2.Cells(cRo, cRowTxt - 1) = Sheet1.Cells(countaTxt, 1) '&atilde;&Ecirc;&egrave;&agrave;&Aring;&cent;&Atilde;&Euml;&Ntilde;&Ecirc;&cent;&eacute;&Ograve;&sect;&Euml;&sup1;&eacute;&Ograve;
a = Worksheets("sheet1").Cells(countaTxt, cRowTxt).Value
b = InStr(1, a, ":", vbTextCompare)
c = Worksheets("Sheet1").Cells(countaTxt, cRowTxt).Characters.Count
a = Mid(a, b + 1, c - b)
d = InStr(1, a, "part:", vbTextCompare)
If d = 0 Then GoTo finish2
f = Mid(a, 1, d - 2)
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f
'====================================================
Do
Do

b = InStr(1, a, ",part:", vbTextCompare)
a = Mid(a, b + 6, c - b)
d = InStr(1, a, "||Mfg:", vbTextCompare)
b = InStr(1, a, ",part:", vbTextCompare)
If d = 0 And b = 0 Then GoTo finish
f = Mid(a, 1, b - 1)
g = InStr(1, f, "Mfg:", vbTextCompare)
'*******************

If g = 0 Then
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
cRo = cRo + 1
Else: End If

Loop While g = 0
f = Mid(f, 1, d - 1)
g = InStr(1, f, "Mfg:", vbTextCompare)
'*******************

If g = 0 Then
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = f 'Part string
cRo = cRo + 1
Else: End If



Do
b = InStr(1, a, "||Mfg:", vbTextCompare)
a = Mid(a, b + 6, c - b)
d = InStr(1, a, ",part:", vbTextCompare)
b = InStr(1, a, "||Mfg:", vbTextCompare)
f = Mid(a, 1, d - 1)
g = InStr(1, f, ",part:", vbTextCompare)
If g = 0 Then
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = f 'Mfg
Else: End If
Loop While g <> 0
Loop While g = 0
finish:
Worksheets("sheet2").Cells(cRo, cRowTxt + 1).Value = a 'Part string
cRo = cRo + 1
countaTxt = countaTxt + 1: GoTo out
finish2:
MsgBox "&auml;&Aacute;&egrave;&Aacute;&Otilde; Part", vbOKOnly
Worksheets("sheet2").Cells(cRo, cRowTxt).Value = a
cRo = cRo + 1
countaTxt = countaTxt + 1
out:
Loop Until Sheet1.Cells(countaTxt, 1) = ""
End Sub



ช่วยลอง test Code นี้หน่อยนะครับ :)

ได้แล้วคะ ขอบคุณมากกกๆๆนะคะ เก่งจังคะ
ถ้าหนูจะทำเป็น Function ต้องทำไงบ้างคะ แนะนำหน่อยคะ
จะทำเป็น add ins เพราะคอลัมน์ของ mfg และ Item ในไฟล์ต่างๆ
อาจไม่ได้อยู่ใน column A และ B อย่างในไฟล์ที่โพส
ก็เลยต้องให้ user คีย์มาว่า mfg และ Item อยู่ในคอลัมน์อะไร
ในกรณีนี้ สามารถทำเป็น add ins ได้มั้ยคะ ได้หรือไม่ได้ช่วยบอกด้วยคะ
หรือควรใช้วิธีอื่น ช่วยแนะนำด้วยนะคะ

ขอบคุณทุกคนมากนะคะที่มาช่วยตอบให้...ซาบซึ้งจริงๆคะ

chatchat
16 May 2007, 20:15
ข้างล่างนี้ฉบับแก้ไขนะ
จากคำถามที่ว่า จะทำ add in ยังไง สร้าง ฟังก์ชั่นยังไง ผมว่ามีคำตอบให้แล้ว ลองค้นๆดู คำถามเก่าๆนะครับ เพราะไม่งั้น จะกลายเป็นว่า ทำให้หมดทุกอย่างเลย มาถึงขั้นตอนนี้ผมว่าคงไม่ยากแล้วล่ะครับ เพราะถ้าเอา code เอา add-in ไปใช้เลย โดยไม่ทราบว่ามันทำงานยังไง จะผิดจุดประสงค์ของบอร์ดนะครับ
ผมว่าคุณลองเอา add-in function ที่คุณได้ลองสร้างขึ้นมาแล้ว มาให้หลายๆคนในบอร์ดนี้ดู และช่วยให้คำแนะนำ แบบนี้จะได้ประโยชน์กว่านะครับ ;)


Sub Macro()
Sheet2.Range("A2:D65536").ClearContents
Dim a, bb, posMfg, posPart, c, posPartEnd, Ro, RoPart, RoMfg As Integer
Dim txtMfg, txtPart, cutText, ExText As String
Ro = 3 'เริ่มแแถวที่เท่าไหร่
RoPart = 2
RoMfg = 2
Do
ExText = Worksheets("sheet1").Cells(Ro, 2).Text & "|||"
Worksheets("sheet2").Cells(RoMfg, 1).Value = Worksheets("sheet1").Cells(Ro, 1).Value
Worksheets("sheet2").Cells(RoMfg, 4).Value = Worksheets("sheet1").Cells(Ro, 3).Value
a = Len(ExText)
For bb = 1 To a
posMfg = InStr(bb + 1, ExText, "Mfg:", vbTextCompare) ' หาตำแหน่งของ Mfg:
If posMfg = 0 Then 'ถ้าบรรทัดนี้มี mfg: เดียว
posMfg = Len(ExText)
Else: End If 'ถ้าบรรทัดนี้มี mfg: เดียว
For c = 1 To posMfg
If bb = 1 Then 'เริ่มเช็คอักษรตัวแรก
cutText = Mid(ExText, bb, posMfg - 3)
Else
cutText = Mid(ExText, bb - 1, posMfg - (bb + 1))
End If
posPart = InStr(c, cutText, "Part:", vbTextCompare) '12
c = posPart 'แก้ไข
posPartEnd = InStr(posPart + 1, cutText, "Part:", vbTextCompare) '36
If posPartEnd = 0 Then 'เจอ part ตัวสุดท้ายแล้ว
txtPart = Mid(cutText, posPart + 5, Len(cutText) - (posPart))
Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
RoPart = RoPart + 1
Exit For 'c
Else 'part ตัวสุดท้ายแล้ว
txtPart = Mid(cutText, posPart + 5, posPartEnd - posPart - 6)
Worksheets("sheet2").Cells(RoPart, 3).Value = txtPart
RoPart = RoPart + 1
End If
Next c
txtMfg = Mid(cutText, 5, InStr(1, cutText, "Part:", vbTextCompare) - 6) 'แสดงชื่อ Mfg:
Worksheets("sheet2").Cells(RoMfg, 2).Value = txtMfg

RoMfg = RoMfg + (RoPart - RoMfg)
bb = posMfg
Next bb
Ro = Ro + 1
Loop Until Worksheets("sheet1").Cells(Ro, 2).Text = ""
Worksheets("sheet2").Select
End Sub

anntiant
16 May 2007, 20:31
ขอบคุณ คุณ chatchat มากนะคะ