รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ

[ศุภาพิชญ์]

ค่ะ ข้อมูลตัวอักษรไม่เท่ากันค่ะ พอมีทางไหมค่ะ

[ศุภาพิชญ์]

ที่ขึ้นตัวแดง error พอcopyมา ก็จะชึ้ยกะพริบที่ sub test สีเหลือง กด fn f5 ใช่ไหมค่ะ แล้วเคอเซอวางตรงไหนค่ะ ขอบคุณค่ะ ยังขึ้นerror อยู่เลยค่ะ

[ศุภาพิชญ์]

ต้องเอาเคอเซอวางตรงไหนค่ะ 1. Copy สูตรมาวางตรงmodule 2. แล้วกด save 3. กด f5 4. แต่ยังขึ้น error ตรงrange ("A1") .select ค่ะ เป็นสีแดง ขอบคุณค่ะ

[ศุภาพิชญ์]

ต้องเอาเคอเซอวางตรงไหนค่ะ 1. Copy สูตรมาวางตรงmodule 2. แล้วกด save 3. กด f5 4. แต่ยังขึ้น error ตรงrange ("A1") .select ค่ะ เป็นสีแดง ขอบคุณค่ะ

[puriwutpokin]

แนบไฟล์มาดูอีกครั้งครับ

[snasui]

หน้าบรรทัด Code ที่ติดสีแดง ให้ลบช่องว่างทิ้งให้หมดจน Code ชิดหน้าสุด เมื่อลบช่องว่างไปแล้ว Code ก็จะทำงานได้ จากนั้นค่อยจัดเยื้องตามต้องการครับ

ปกติการคัดลอก Code ไปวางให้คลิกข้อความ SELECT ALL ในกล่อง Code ไม่ควรลากคลุมเองแล้วคัดลอกไปใช้ครับ

[ศุภาพิชญ์]

อาจารย์ค่ะ ไฟล์ที่อ.puriให้มาที่ชื่อ ไฟล์ data อันใหม่ ใส่code เปิดได้แล้วค่ะ ขอบคุณมากนะค่ะ แต่จะรบกวนพี่ๆ อาจารย์ค่ะ เห็นว่าต้องdata ต้องตัวอักษรเท่ากันแต่ไฟล์ที่จะได้มา ตัวอักษรไม่เท่ากันและมีบรรทัดประมาณ 20000 กว่าบรรทัด จะตัดตัวอักษรเวลาส่งไฟล์ไปก็จะไม่เป็นข้อความค่ะ รบกวนพี่ๆอาจารย์ค่ะ ขอบคุณมากนะค่ะ

ไฟล์ที่อาจารย์ puri ทำให้ค่ะขอบคุณพี่มากค่ะ แต่อาจารย์บอกว่า dataต้องเท่ากัน พอแก้ได้ไหมค่ะ เห็นว่าdata ที่จะได้มายาวและไม่เท่ากัน และมีตั้ง20000 เกือบ30000 บรรทัดค่ะ ขอบคุณมากค่ะ รบกวนจัง พยายามศึกษาค่ะ แต่งวดนี้งานเร่งมากมายค่ะ เลยทำไม่ทันค่ะ ขอบคุณจากใจค่ะ

[snasui]

อ่านแล้วไม่เข้าใจครับ

ช่วยอธิบายมาอีกรอบพร้อมทั้งแนบไฟล์ตัวอย่าง ชี้ให้เห็นว่าปัญหาคืออะไร ต้องการคำตอบเป็นอย่างไร

data ต้องเท่ากันหมายถึง data ตรงไหนต้องเท่ากัน กรุณานำไปทดสอบก่อนที่จะแจ้งกลับ จะได้ทราบว่าเป็นปัญหาเช่นที่ว่านั่นหรือไม่ อย่างไรครับ

[ศุภาพิชญ์]

Re: รบกวนค่ะ มีวิธีแยก sheet ได้ครั้งเดียวทีละมากๆ ค่ะ
รายงานในข้อความ
อ้างคำพูด





#20

โพสต์โดย puriwutpokin » พฤหัสฯ. มี.ค. 30, 2017 7:41 pm

ลองดูตามไฟล์แนบนะครับ ผมก็คัดลอกมาลงปกติครับ แต่อันหนึ่งที่ต้องเป็น คือ data ควรมีจำนวนเลขเท่ากันเช่น
data11
data01
ไม่ใช่
data11
data1
เพราะเวลาดึงข้อมูลมามันจะไม่ถูกต้องครับ


รบกวนค่ะ อาจารย์ พอดีทางแก้ไหมค่ะ ตรงคอลัมภ์ b และ e ค่ะ
ขอบคุณค่ะ

[ศุภาพิชญ์]

Code: Select all

Sub Test()
Dim xdata As String
For r = 2 To Range("E19").End(xlUp).Row
ThisWorkbook.ActiveSheet.Columns("H:J").EntireColumn.Delete
Range("F2").Value = Range("E" & r).Value
xdata = Range("F2").Value
            Range("A1").Select
    Selection.CurrentRegion.Select
    Range("A1:C19").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "F1:F2"), CopyToRange:=Range("H1"), Unique:=True
        ActiveSheet.Columns("H:J").Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & xdata & ".xlsx"
Application.CutCopyMode = False
ActiveWorkbook.Close True
Next r
End Sub

[puriwutpokin]

ลองรันดูก่อนครับ ผมลองรันบางครั้งมันจะฟิลเตอร์มาผิดเมื่อวาน แต่วันนี้ไม่ผิดแล้วครับ ลองเทสท์ดูเลยครับติดตรงไหนค่อยมาถามกันใหม่

[ศุภาพิชญ์]

อาจารย์ค่ะ ขอบคุณมากนะค่ะ รันได้แล้วค่ะ แต่ที่อาจารย์บอกเรื่อง data พอจะทำไงดีค่ะ ข้อมูลเยอะมากเลย ถ้าจะให้ไฟล์ดาต้าเท่ากัน ทุกตัวอักษร เห็นว่าไฟล์ที่จะส่งมาให้ทำ ตัวอักษรไม่เท่ากัน พี่เขาจะใส่วันที่ จำนวน และชือ เห็นว่ามีต้อง 20000 เกือบ 30000 บรรทัด จะมาแก้ทีละไฟล์ถ้าจะเสร็จไม่ท้นแน่เลยค่ะ พอดีทางหน่วยงานอื่นเขาจะส่งไฟล์มา แล้วเราก็แยกส่งต่ออีกที่หนึ่งค่ะ พอพี่เขาส่งมาเราก็ทำแต่พี่เขาบอกต้องรีบส่งไปภายในครึ่งชั่วโมง เพราะอีกทีต้องการด่วนค่ะ ขอบคุณอาจารย์มากเลยนะค่ะ สำหรับความช่วยเหลือในครั้งนี้ และพี่ๆ ทุกคนค่ะ

[puriwutpokin]

ผมทดสอบแล้วเรื่อง data ไม่มีปัญหาครับ ส่วนเรื่องข้อมูลจำนวนมาก ให้ขยายช่วงด้วยครับ

Code: Select all

'โค้ดอื่น...
For r = 2 To Range("E30000").End(xlUp).Row
'โค้ดอื่น...

Code: Select all

'โค้ดอื่น...
Selection.CurrentRegion.Select
Selection.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "F1:F2"), CopyToRange:=Range("H1"), Unique:=True
        ActiveSheet.Columns("H:J").Copy
'โค้ดอื่น...

[ศุภาพิชญ์]

ขอบคุณอาจารย์และพี่ๆทุกท่านมากค่ะ

[ศุภาพิชญ์]

อาจารย์ค่ะ รบกวนค่ะ พอดีได้ file มาแล้วลองทำหลายรอบคอลัมภ์มาไม่ครบค่ะ ขอบคุณนะค่ะ

Code: Select all

Sub Test()
Dim xdata As String
For r = 2 To Range("CP22038").End(xlUp).Row
ThisWorkbook.ActiveSheet.Columns("CS:GF").EntireColumn.Delete
Range("CQ2").Value = Range("CP" & r).Value
xdata = Range("CQ2").Value
            Range("A1").Select
Selection.CurrentRegion.Select
Selection.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "CQ1:CQ2"), CopyToRange:=Range("CS1"), Unique:=True
        ActiveSheet.Columns("CS:GF").Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & xdata & ".xlsx"
Application.CutCopyMode = False
ActiveWorkbook.Close True
Next r
End Sub

[ศุภาพิชญ์]

เหมือนถ้าข้อมูลมากๆ จะดึงคอลัมภ์มาได้แต่อันบนค่ะ ขอบคุณค่ะ

[snasui]

ให้ถามพร้อมแนบไฟล์เสมอจะได้ช่วยทดสอบได้ครับ

[puriwutpokin]

ผมลองทดสอบดูแล้วก็ปกตินะครับ แต่ต้องว่าข้อมูลที่แท้จริงเป็นอย่างไร ตามอาจารย์snasui แจ้งควรแนบไฟล์มาด้วยครับ

[ศุภาพิชญ์]

ขอบคุณมากค่ะ ได้แล้วค่ะ