จัดทำรายงานลักษณะหนังสือเวียน

[palmy]

เรียน อาจารย์ครับ
ผมได้ลองศึกษาและนำข้อมูลใน Forum ของอาจารย์ไปลองเขียน Code VB
ทำรายงานเพื่อพิมพ์สรุปข้อมูลรายได้ลักษณะเป็นหนังสือเวียน (ตามไฟล์แนบ)
แต่ทั้งนี้ข้อมูลพนักงานจะเยอะมาก หากมีข้อมูลมากกว่า 1000 ราย
การประมวลผลจะช้ามาก ผมเลยอยากให้โปรแกรมสามารถเลือกพิมพ์
รายเขต หรือรายกลุ่มได้ ตามที่เราเลือก (จากSheet Invoice)
แต่ไม่ทราบจะเขียน Code ยังงัย รบกวนอาจารย์ช่วยดูและให้คำแนะนำเขียน
Code ให้ศึกษาด้วยครับ

[snasui]

ลองสร้าง Database ไว้ที่ชีทอื่นแล้วบันทึก Macro โดยการใช้ Advanced Filter เพื่อนำเฉพาะข้อมูลที่ต้องการมาไว้ที่ชีท Invoice จากนั้นค่อย Run Code ตามปกติครับ

[palmy]

ผมลองทำวิธี Advanced Filter โดยนำข้อมูลกรองออกไปใส่ Sheet ใหม่ มันฟ้องว่า "คุณสามารถคัดลอกเฉพาะข้อมูลที่ถูกกรองเท่านั้นไปสู่แผ่นงานที่ใช้งานอยู่" คือกรองข้อมูลไปอีก Sheet ไม่ได้ครับ แต่ลองใช้การกรองขั้นสูง ในSheet เดียวกัน ก็สามารถทำได้ หรือผมใช้การกรองไม่ถูกต้องครับ
รบกวนอาจารย์ช่วยแนะนำด้วยครับ พอจะทำเป็นรูปบรรยาย + เขียนโค๊ตมาโครแนะนำได้หรือเปล่าครับ

[snasui]

การเขียน Macro จำเป็นต้องเขียนมาเองครับ ติดตรงไหนค่อยถามครับ

[palmy]

เรียนอาจารย์ครับ
ผมเขียน Code ดังนี้ เพื่อพิมพ์หนังสือเวียน แต่ทั้งนี้ ผมได้ขยับแถว(Row)
ใน Sheet Name ลง เริ่มตั้งข้อมูลตั้งแต่แถวที่ 4 ลงไป(หัวCollum)
ทำให้การพิมพ์ข้อมูลรายการไม่ครบถ้วน ข้อมูลรายการ Sheet Report หายเกือบหมด ลองปรับ Range("B" & i)
เป็น Range("B4" & i) รายการใน Sheet Report เริ่มจากแถวข้อมูลที่ได้ 5 ได้ถูกต้อง แต่
รายการข้อมูลพนักงานช่วงหลังลำดับที่ 100 หายไป ขอคำแนะนำด้วยครับ

Public Sub EnvelopePaste()
Dim rSource As Range
Dim rTarget As Range
Dim i As Long, j As Long
Application.ScreenUpdating = False
With Sheets("Report")
.Range("A:O").UnMerge
.Range("A:O").ClearContents
End With
Set rSource = Sheets("Invoice").Range("A1:G8")
j = 1
For i = 1 To 10000 Step 1
Sheets("Invoice").Range("H1") = i
If Sheets("NAME").Range("B" & i) = "" Then Exit For
With Sheets("Report")
Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 7))
End With
rSource.Copy
rTarget.PasteSpecial xlPasteValues
rTarget.PasteSpecial xlPasteFormats
j = j + 8
Next i
Application.CutCopyMode = False
MsgBox "Finish"
Application.ScreenUpdating = True
End Sub

[snasui]

ช่วยปรับ Code ให้แสดงเป็น Code โดยดูตัวอย่างจากกระทู้นี้ เพื่อสะดวกในการอ่านและ Copy ไปทดสอบครับ viewtopic.php?f=3&t=1187

[palmy]

ขอโทษด้วยครับอาจารย์ ลง Code ใหม่แล้วครับ

Code: Select all

Public Sub EnvelopePaste()
Dim rSource As Range
Dim rTarget As Range
Dim i As Long, j As Long
Application.ScreenUpdating = False
With Sheets("Report")
    .Range("A:O").UnMerge
    .Range("A:O").ClearContents
End With
Set rSource = Sheets("Invoice").Range("A1:G8")
j = 1
For i = 1 To 10000 Step 1
    Sheets("Invoice").Range("H1") = i
    If Sheets("NAME").[color=#0000FF]Range("B" & i)[/color] = "" Then Exit For
    With Sheets("Report")
    Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 7))
    End With
        rSource.Copy
        rTarget.PasteSpecial xlPasteValues
        rTarget.PasteSpecial xlPasteFormats
        j = j + 8
Next i
Application.CutCopyMode = False
MsgBox "Finish"
Application.ScreenUpdating = True
End Sub

[snasui]

จาก Code เดิม If Sheets("NAME").Range("B" & i) = "" Then Exit For ควรเป็น

If Sheets("NAME").Range("B" & 4 + i) = "" Then Exit For เพื่อจะบอกโปรแกรมว่าให้เริ่มที่บรรทัดที่ 5

[palmy]

เรียนอาจารย์ครับ จากการปรับแก้ไข สามารถพิมพ์รายการได้ครบถ้วนแล้วครับ
ขอเรียนถามเพิ่มเติม เคยตั้งคำถามเกี่ยยวกับการใช้สูตร Offset ดึงข้อมูล กรณี
เป็นตัวเลข อยากให้แสดงผลเป็นหลักพัน จาก 1000 เป็น 1,000
ซึ่งอาจารย์ได้เคยแนะนำให้ตั้งค่า Cell เป็นกำหนดเอง (#,##0) แต่ผมใช้ สูตร ดังนี้

Code: Select all

="ธ.ค. :  "&OFFSET(Name!$A$4,H1,21)&"  ม.ค. :  "&OFFSET(Name!$A$4,H1,22)&"  ก.พ. :  "&OFFSET(Name!$A$4,H1,23)&"  มี.ค. :  "&OFFSET(Name!$A$4,H1,24)

และดึงข้อมูลไปเป็นรายการในอีก Sheet ลองตั้งค่า Cell แบบข้างต้นไม่สามารถใช้ได้
เรียนปรึกษาเพิ่มเติมครับ ควรปรับค่าสูตรอย่างไรครับ

[snasui]

ค่าที่ได้จากการเชื่อมข้อความเป็น Text ไม่ใช่ Number การกำหนด Format ในสายอักขระที่ได้จากการเชื่อมกันสามารถใช้ฟังก์ชั่น Fixed เข้าไปด้วยได้ ยกตัวอย่างเช่น

="ธ.ค. : "&Fixed(OFFSET(Name!$A$4,H1,21),0)&" ม.ค. : "&Fixed(OFFSET(Name!$A$4,H1,22),0)&" ก.พ. : "&Fixed(OFFSET(Name!$A$4,H1,23),0)&" มี.ค. : "&Fixed(OFFSET(Name!$A$4,H1,24),0)

[palmy]

ขอโทษครับอาจารย์ ถามไม่ละเอียดรอบคอบในคำถามเดียว จากสูตรที่อาจารย์แนะนำ ใช้ได้ครับ
แต่บังเอิญเจอกรณีมีทศนิยมด้วยครับ ต้องปรับยังไงครับ

[snasui]

ลองเปลี่ยนเลข 0 เป็นเลขใด ๆ แล้วดูผลครับ

[palmy]

ปรับใช้ได้แล้วครับ ขอบคุณมากครับ

[palmy]

เรียนอาจารย์ครับ ผมได้ลองใช้ Validation กับรายงานข้อมูลตัวนี้ โดยศึกษาจาก http://snasui.blogspot.com/2010/07/validation.html
ขอเรียนถามอาจารย์เพิ่มเติมครับ กรณีจากตัวอย่าง Sub_Group ถ้ามีข้อมูลที่ซ้ำกัน จะต้องปรับสูตรอย่างไรครับ จากที่ใช้แบบนี้

Code: Select all

=OFFSET(Sheet1!$D$2,MATCH(Sheet1!$F2,Sheet1!$C$2:$C$7,0)-1,0,COUNTIF(Sheet1!$C$2:$C$7,Sheet1!$F2))

ปรากฎว่ารายการขึ้นทั้งหมดรวมค่าซ้ำๆกัน จะให้กรองเหลือค่าไม่ซ้ำได้หรือเปล่าครับ

[snasui]

ปรากฎว่ารายการขึ้นทั้งหมดรวมค่าซ้ำๆกัน จะให้กรองเหลือค่าไม่ซ้ำได้หรือเปล่าครับ

สูตรที่ถามมานั้นเป็นการดึงค่าไปแสดงเฉย ๆ หากต้องการนำค่าไม่ซ้ำปแสดงให้ดูสูตรในบทความตาม Link นี้ครับ http://snasui.blogspot.com/2010/05/blog-post.html

[palmy]

ลองศึกษาดูแล้วครับ คิดว่าน่าจะใช้การกำหนดชื่อ แล้วใช้สูตรที่ 4.การหารายการที่ไม่ซ้ำด้วยฟังค์ชัน
แล้วไปกำหนด Validation > List > F3 ดึงชื่อที่ตั้งไว้ (ไม่ทราบว่าคิดถูกหรือเปล่าครับ)
ทั้งนี้ลอง ใช้สูตรที่ใช้นับว่ามีค่าที่ไม่ซ้ำกี่ค่า คีย์ =Sumproduct(1/Countif(A1:A40000,A1:A40000)) Enter
ได้คำตอบเป็นเลข 0 ข้อมูลเยอะเกินไปหรือตั้งปรับอะไรเพิ่มไหมครับ เพราะข้อมูลซ้ำเยอะ

[snasui]

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

[palmy]

กำลังดำเนินการครับ แต่ปรากฎว่า แค่ขั้นตอนแรก จากการใช้สูตร =SUMPRODUCT(1/COUNTIF(C2:C36311,C2:C36311)) เพื่อหาจำนวนค่าไม่ซ้ำ
การประมวลผลช้ามาก แทบจะกด Cell ใดๆ ต่อไม่ได้เลยครับ หลังรอพักใหญ่ คำตอบที่ได้เป็น 0 อีกครับ

[snasui]

หากไฟล์ตัวอย่างมาขนาดใหญ่มาก ลอง Copy รายการในคอลัมน์ C ทั้งหมดมาวางใน Notepad แล้ว Save เป็น .txt จากนั้น Zip แล้วแนบมาดูกันครับ

[palmy]

แนบไฟล์มาแล้วครับอาจารย์