การรวมข้ามชีตแบบมีเงื่อนไข

[yangkodza]

จากแผ่นงาน อยากทราบว่าที่แผ่นงานสรุปเทอม1
เราจะมีวิธีหา มาสาย ลากิจ ลาป่าว ลาคลอด ของแต่ละคนได้อย่างไรครับ

รายเดือน2.xlsm

[parakorn]

ตัวอย่างโค้ดครับ

Code: Select all

Sub Save()
'
' Save Macro
'

For i = 2 To Sheets.Count - 1
    Sheets(i).Select
    Application.Goto Reference:="OFFSET(R3C2,1,,COUNTA(C1)-2,5)"
    Selection.Copy
    Sheets("ÊÃØ»à·ÍÁ 1").Select
    Application.Goto Reference:="R4C2"
    If Range("B4") = "" Then Range("B4").Select Else
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next i

End Sub

แล้วใช้ Pivot Table สรุปผลอีกทีครับ

[yangkodza]

ที่แผ่นงาน สรุปเทอม1 cell C4 อยากได้แบบ
ค้นข้อมูลในแต่ละแผ่นงานของเดือน ที่มีชื่อ นางสาวศุภางค์ ถ้ามีชื่อนี้ก็ให้เอาผลมาสายของคนนี้มาบวกกันทั้ง 6 เดือน
ประมาณนี้ครับ ที่แผ่นงานรายเดือนแต่ละแผ่น เรคคอดไม่เท่ากันเพราะว่า ผมจะตัดคนที่ ไม่มีขาดลามาสายออกไปครับ
ช่วงข้อมูลจริงๆ สมมุติว่ามีแค่ 15 คนครับ ตามรายชื่อในแผนงานสรุปเทอม 1
รบกวนชี้แนะด้วยครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Dim rsAll As Range, rs As Range
Dim rtAll As Range, rt As Range
Dim sh As Worksheet
With Worksheets("สรุปเทอม 1")
    Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
    For Each rs In rsAll
        For Each sh In Worksheets
            If sh.Name <> "สรุปเทอม 1" Then
                Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp))
                For Each rt In rtAll
                    If rt.Value = rs.Value Then
                        rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _
                            rt.Offset(0, 1).Value
                        rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _
                            rt.Offset(0, 2).Value
                        rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _
                            rt.Offset(0, 3).Value
                        rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _
                            rt.Offset(0, 4).Value
                    End If
                Next rt
            End If
        Next sh
    Next rs
End With

[yangkodza]

ตัวอย่าง Code ครับ

Code: Select all

Dim rsAll As Range, rs As Range
Dim rtAll As Range, rt As Range
Dim sh As Worksheet
With Worksheets("สรุปเทอม 1")
    Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
    For Each rs In rsAll
        For Each sh In Worksheets
            If sh.Name <> "สรุปเทอม 1" Then
                Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp))
                For Each rt In rtAll
                    If rt.Value = rs.Value Then
                        rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _
                            rt.Offset(0, 1).Value
                        rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _
                            rt.Offset(0, 2).Value
                        rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _
                            rt.Offset(0, 3).Value
                        rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _
                            rt.Offset(0, 4).Value
                    End If
                Next rt
            End If
        Next sh
    Next rs
End With

ยอดเลยครับสะดวกมากเลย รบกวนอาจารย์ช่วยปรับ Code ให้อีกนิดครับ
ตัวแผ่นงานของผมจะเรียงแบบนี้ หน้าหลัก,พ.ค.,มิ.ย.,ก.ค.,ส.ค.,ก.ย.,ต.ค.1,เทอม 1,ต.ค.2,พ.ย.,ธ.ค.,ม.ค.,ก.พ.,มี.ค.
อยากให้แผ่นงาน macro ดังกล่าว อ้างอิงแผนงานที่ 2 ถึง 7 ครับ ขอบคุณครับ

[snasui]

สามารถปรับตรง If sh.Name <> "สรุปเทอม 1" Then ได้เลยครับ

ลองศึกษา Link นี้เป็นการใช้ sh.Index เข้ามาช่วย viewtopic.php?f=3&t=3884&view=next#p25118 จากนั้นลองปรับมาเองก่อน ติดตรงไหนค่อยถามกันต่อ ทุกคำถามต้องผ่านการทดลองเขียนมาเองก่อนแล้วครับ

[yangkodza]

Code: Select all

Sub Macro1()
Dim rsAll As Range, rs As Range
Dim rtAll As Range, rt As Range
Dim sh As Worksheet
Application.ScreenUpdating = False
    Range("C4:F18").Select
    Selection.ClearContents
    Range("C4").Select
With Worksheets("สรุปเทอม 1")
    Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
    For Each rs In rsAll
        For Each sh In Worksheets
            'If sh.Name <> "สรุปเทอม 1" Then      'ถูกต้องต้นฉบับ
            'If sh.Name <> "สรุปเทอม 1,ต.ค.2,พ.ย.,ธ.ค.,ม.ค.,ก.พ.,มี.ค.,สรุปเทอม 2,สรุปทั้งปี" Then 'ไม่ผ่าน
            'If sh.Name <> Worksheets.Count Then      'ถูกต้องต้นฉบับ  'ไม่ผ่าน
           If sh.Name <> Sheets(Array("สรุปเทอม 1", "ต.ค.2", "พ.ย.", "ธ.ค.", "ม.ค.", "ก.พ.", "มี.ค.", _
           "สรุปเทอม 2", "สรุปทั้งปี")) Then
            Sheets("สรุปเทอม 1").Activate
                            Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp))
                For Each rt In rtAll
                    If rt.Value = rs.Value Then
                        rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _
                            rt.Offset(0, 1).Value
                        rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _
                            rt.Offset(0, 2).Value
                        rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _
                            rt.Offset(0, 3).Value
                        rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _
                            rt.Offset(0, 4).Value
                    End If
                Next rt
            End If
        Next sh
    Next rs
End With
Application.ScreenUpdating = True
End Sub

ผมหาวิธีทำยังไม่ผ่านครับ รบกวนอาจารย์ชี้แนะเพิ่มเติมครับ

[snasui]

อยากให้แผ่นงาน macro ดังกล่าว อ้างอิงแผนงานที่ 2 ถึง 7 ครับ

ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
If sh.Index >= 2 and sh.Index <= 7 Then
'Other code

[yangkodza]

อยากให้แผ่นงาน macro ดังกล่าว อ้างอิงแผนงานที่ 2 ถึง 7 ครับ

ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
If sh.Index >= 2 and sh.Index <= 7 Then
'Other code

ขอบคุณมากครับ สามารถนำไปประยุกต์กับเทอม2 ได้แล้วครับ