snasui wrote:ส่วนข้อ 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
สำหรับข้อ 1 ให้เขียน Code เพื่อลบรายการที่ซ้ำออกไป ดูตัวอย่างตามด้านล่างครับ
แฮมอาจาร์ยแกล้ง