ขอถามเกี่ยวกับการทำ Report

[yodpao.b]

ขอถามเกี่ยวกับการทำ Report คงจะไม่ใช่เป็นการถามครับ เพราะผมลองทำมา 3-4 วันแล้ว
ส่วนใหญ่จะใช้ คำสั่งใน excel ทำ หรือไม่ ก็ Pvitetabel ทำ ไม่ใกล้เคียงเลยซักอย่าง
จึงอยากจะรบกวนอาจาร์ยช่วยดูและแก้ไขให้หน่อยครับ
คำถามอยู่ในไฟล์ EXcel ที่แนบมาครับ
ช่วยหน่อยนะครับขอถาม 2 ข้อ

[snasui]

สำหรับข้อ 1 ให้เขียน Code เพื่อลบรายการที่ซ้ำออกไป ดูตัวอย่างตามด้านล่างครับ

Code: Select all

Sub DelDup()
    Dim rngStart As Range
    Dim i As Integer, l As Long
    Set rngStart = Sheets("Report").Range("E10")
    l = rngStart.End(xlDown).Row + 1 - rngStart.Row
    i = 1
    Do While i <= l
        Set rngStart = rngStart.Resize(i)
        If Application.CountIf(rngStart, rngStart(i)) > 1 Then
            rngStart(i) = ""
        End If
        i = i + 1
    Loop
    rngStart.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

ส่วนข้อ 2 เขียน Code มาเองแล้วยัง Code อยู่ที่ Module ไหน ชื่อว่าอะไรครับ

[yodpao.b]

ส่วนข้อ 2 เขียน Code มาเองแล้วยัง Code อยู่ที่ Module ไหน ชื่อว่าอะไรครับ

ขอโทษครับให้ข้อมูลไม่ละเอียด
Code อยู่ที่ Module Report2Personnel สั่งให้ทำงานโดย Private Sub CommandButton114_Click()

Module Report2Personnel ()
Option Explicit
Option Base 1

Sub ReportDetailPersonnel()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long

rl = Rows.Count
With Worksheets("Data_Personnel")
Set rAll = .Range("B4", .Range("B" & rl).End(xlUp))
End With
For Each r In rAll
'If r = Worksheets("Report").Range("F1") Then
lng = lng + 1
ReDim Preserve a(11, lng)
a(1, lng) = r.Offset(0, 1)
a(2, lng) = r.Offset(0, 2)
a(3, lng) = r.Offset(0, 10)
a(4, lng) = r.Offset(0, 11)
a(5, lng) = r.Offset(0, 3)
a(6, lng) = r.Offset(0, 4)
a(7, lng) = r.Offset(0, 5)
a(8, lng) = r.Offset(0, 6)
a(9, lng) = r.Offset(0, 7)
a(10, lng) = r.Offset(0, 8)
a(11, lng) = r.Offset(0, 9)
'End If
Next r
If lng > 0 Then
With Worksheets("Report")
Set rt = .Range("B10", .Range("L" & lng - 1 + 10))
If .Range("B10") <> "" Then 'Check if isblank
.Range("B10", .Range("B" & rl).End(xlUp).Offset(0, 11)).ClearContents
End If
.Range("B10:L10").Copy
rt.PasteSpecial xlPasteFormats
rt = Application.Transpose(a)
.Range(.Range("B9").End(xlDown).Offset(1, 0), .Range("L" & rl)).Clear 'Change new start cell
End With
'Else
'MsgBox " ไม่มีประวัติ { ชื่อนี้ } ในการทำล่วงเวลาของเดือนนี้ อยู่ในฐานข้อมูล "
End If

Sheets("Report").Select
If Range("B10") <> "" Then
Range("B9:L10").Select
With Selection ' ตั้งค่าต้วหนังสือไว้ซ้าย ขวา
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Range("F9:F10").Select
With Selection ' ตั้งค่าต้วหนังสือไว้ซ้าย ขวา
.HorizontalAlignment = xlRight
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Range("F10").Select
Selection.NumberFormat = "General" 'จัดรูปแบบทั่วไป

Call ReportColumnWidth
Call ReportFormatText
'Call ReportColorBar
Call ReportFormatAll
End If
Range("A9").Select

End Sub

Sub ReportHeadelPersonnel()

Sheets("Report").Select
Range("B9").Select ' สร้างวันที่และวางแบบค่า
Range("B1") = "="" รายงานแสดงข้อมูลรายละเอียดผู้เข้าร่วมสัมมนา ณ. วันที่ ""&TEXT(TODAY(),""DD-MMMM-BBBB"")"
Range("B1") = Range("B1")

Range("B9").Select ' เชื่อมโยงกับ Sheet Data_Personnel
Range("B9") = "=Data_Personnel!R3C3"
Range("C9") = "=Data_Personnel!R3C4"
Range("D9") = "=Data_Personnel!R3C12"
Range("E9") = "=Data_Personnel!R3C13"
Range("F9") = "=Data_Personnel!R3C5"
Range("G9") = "=Data_Personnel!R3C6"
Range("H9") = "=Data_Personnel!R3C7"
Range("I9") = "=Data_Personnel!R3C8"
Range("J9") = "=Data_Personnel!R3C9"
Range("K9") = "=Data_Personnel!R3C10"
Range("L9") = "=Data_Personnel!R3C11"

Range("B9").Select ' Copy To PasteValues
Range(Selection, Selection.End(xlToRight)).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A9").Select

End Sub

[yodpao.b]

จากคำถามที่ 1ได้ทำแล้วครับผลลัพท์ที่ได้ดีเลยครับ
คำถาม ถ้าข้อมูลไม่ซำกันแต่เราใส่ code นี้ไว้ด้วยก็ไม่มีผลอะไรใช่ไหมครับ ?

Code: Select all

Set rngStart = rngStart.Resize(i)

หมายถึงอะไรครับ?

Code: Select all

If Application.CountIf(rngStart, rngStart(i)) > 1 Then

หมายถึงอะไรครับ?

[snasui]

ลองใช้ Code ตามด้านล่างเข้าไปช่วยในการทำ Report ตามข้อ 2 ครับ

Code: Select all

Sub ReRange()
    Dim rAll As Range, r As Range
    Dim rf As Range, i As Integer
    With Sheets("Report")
        Set rf = .Range("F10:N10")
        Set r = .Range("E10", .Range("E" & _
            Rows.Count).End(xlUp))
        Set rAll = .Range("B9", .Range("L" & _
            Rows.Count).End(xlUp))
        rAll.Sort Key1:=.Range("E10"), Order1:=xlAscending, _
        Header:=xlGuess, Orientation:=xlTopToBottom
    End With
        For i = r.Rows.Count To 2 Step -1
            If r(i) <> r(i).Offset(-1, 0) Then
                r(i).EntireRow.Insert
            Else
                r(i).Offset(0, -3).Resize(1, 3).ClearContents
            End If
        Next i
    rf.Insert xlShiftDown
End Sub

Set rngStart = rngStart.Resize(i) หมายถึงอะไรครับ?

หมายถึงให้ขยายความลึกของข้อมูล rngStart เท่ากับค่าของ i

If Application.CountIf(rngStart, rngStart(i)) > 1 Thenหมายถึงอะไรครับ?

หมายถึงให้นับว่า rngStart ลำดับที่ i มีอยู่ใน rngStart จำนวนมากกว่า 1 ค่าหรือไม่

[yodpao.b]

ขอบคุณครับอาจารย์มาทันเวลาพอดี ผมต้องส่งให้หัวหน้าดูวันจันทร์นี้แล้ว

[yodpao.b]

ได้ทำแล้วครับแต่ยังติดอยู่นิดหนึ่ง
คือบางRecordยังมีชื่อบริษัทอยู่ ดังที่วงไว้ดังรูปด้านล่าง
ดังนั้นจึงแนบไฟล์ให้อาจาร์ยได้ดูครับผม

111.gif

[yodpao.b]

แนบไฟล์

[snasui]

ลอง Run ทีละ Step แล้วสังเกตดูว่า Code ไหนที่ทำการลบค่าที่ซ้ำ ลองปรับที่ Code นั้นให้ครอบคลุมถึงชื่อบริษัทด้วยตัวเองดูก่อน ปรับแล้วไม่ได้ก็ค่อยมาถามกันต่อได้เรื่อย ๆ แนบ Code ที่ลองปรับแล้วมาด้วยครับ

[yodpao.b]

ลองปรับแล้วครับ
จากโคด

Code: Select all

r(i).Offset(0, -3).Resize(1, 3).ClearContents

เป็น

Code: Select all

r(i).Offset(0, -3).Resize(1, 4).ClearContents

ได้ผลตามที่ต้องการแล้วครับ
แฮมอาจาร์ยแกล้ง
ขอบคุณครับที่ให้คิดเองซะบ้างเดี๋ยวสมองฟ่อหมด