Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

Code จากคลิป Search data from multiple sheets ค่ะ

https://www.snasui.com/viewtopic.php?t=12009

Page 1 of 2

Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Wed Jul 26, 2017 7:36 pm
by suka
เรียนอาจารย์ค่ะ

โค้ดด้านล่างนี้นำมาจากโค้ดในคลิป Search data from multiple sheets ลิงค์นี้ค่ะ

https://youtu.be/Jada6hWMJSc

ที่ชีท Sheet1เซลล์ C1 ต้องการ Search ด้วยวันที่ให้โค้ดดึงข้อมูลมาแสดงให้เหมือนตัวอย่างในชีท "ตัวอย่างที่ต้องการ" จากตัวอย่างในไฟล์แนบค่ะ ไม่ทราบควรปรับอย่างไรค่ะ

Code: Select all

Sub SearchMultipleSheets()
        Dim arr(999, 6) As Variant, r As Range
        Dim ws As Worksheet, i As Integer, s As String
        With Sheets(1)
                s = .Range("c1").Value
                .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
        End With
        For Each ws In Worksheets
                If ws.Name <> Sheets(1).Name Or ws.Name <> Sheets("ตัวอย่างที่ต้องการค่ะ").Name Then
                        With ws
                                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                                        If r.Value & r.Offset(0, 1).Value & r.Offset(0, 5).Value & r.Offset(0, 7).Value & r.Offset(0, 8).Value & r.Offset(0, 25).Value _
                                                Like "*" & s & "*" Then
                                                arr(i, 0) = r.Value
                                                arr(i, 0) = r.Offset(0, 1).Value
                                                arr(i, 1) = r.Offset(0, 5).Value
                                                arr(i, 2) = r.Offset(0, 7).Value
                                                arr(i, 3) = r.Offset(0, 8).Value
                                                arr(i, 4) = r.Offset(0, 25).Value
                                                arr(i, 5) = ws.Name
                                                i = i + 1
                                        End If
                               Next r
                        End With
                End If
       Next ws
       With Sheets(1)
            .Range("b3").Resize(i, 7).Value = arr
       End With
End Sub

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Wed Jul 26, 2017 10:55 pm
by DhitiBank
ลองแบบนี้ครับ

Code: Select all

...Code อื่นๆ ...
For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
        If r.Value & r.Offset(0, 1).Value & r.Offset(0, 5).Value & r.Offset(0, 7).Value & r.Offset(0, 8).Value & r.Offset(0, 25).Value _
                Like "*" & s & "*" Then
                arr(i, 0) = r.Value
                arr(i, 0) = r.Offset(0, 1).Value
                arr(i, 1) = r.Offset(0, 5).Value
                arr(i, 2) = r.Offset(0, 7).Value
                arr(i, 3) = r.Offset(0, 8).Value
                arr(i, 4) = r.Offset(0, 25).Value
                arr(i, 5) = ws.Name
                i = i + 1
        End If
    End If
Next r
...Code อื่นๆ ...

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Thu Jul 27, 2017 11:30 am
by suka
ปรับ Code เป็นด้านล่างนี้แล้วเมื่อ Run Code ฟ้องระบายสีเหลืองที่

Code: Select all

If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
ไม่ทราบว่าควรปรับแก้อย่างไรดีคะ

Code: Select all

Sub SearchMultipleSheets()
        Dim arr(999, 6) As Variant, r As Range
        Dim ws As Worksheet, i As Integer, s As String
        With Sheets(1)
                s = .Range("c1").Value
                .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
        End With
        For Each ws In Worksheets
                If ws.Name <> Sheets(1).Name Or ws.Name <> Sheets("ตัวอย่างที่ต้องการค่ะ").Name Then
                        With ws
                                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                                    If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
                                            If r.Value & r.Offset(0, 1).Value & r.Offset(0, 5).Value & r.Offset(0, 7).Value & r.Offset(0, 8).Value & r.Offset(0, 25).Value _
                                                    Like "*" & s & "*" Then
                                                    arr(i, 0) = r.Value
                                                    arr(i, 0) = r.Offset(0, 1).Value
                                                    arr(i, 1) = r.Offset(0, 5).Value
                                                    arr(i, 2) = r.Offset(0, 7).Value
                                                    arr(i, 3) = r.Offset(0, 8).Value
                                                    arr(i, 4) = r.Offset(0, 25).Value
                                                    arr(i, 5) = ws.Name
                                                    i = i + 1
                                            End If
                                    End If
                               Next r
                        End With
                End If
       Next ws
       With Sheets(1)
            .Range("b3").Resize(i, 7).Value = arr
       End With
End Sub

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Thu Jul 27, 2017 11:48 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub SearchMultipleSheets()
    Dim arr(999, 6) As Variant, r As Range
    Dim ws As Worksheet, i As Integer, s As Range
    With Sheets(1)
        Set s = .Range("c1")
        .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
        If ws.Name = "ดูรายละเอียด" Then
            With ws
                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                    If r.Offset(0, 1).Value2 = s.Value2 Then
                        arr(i, 0) = i
                        arr(i, 1) = r.Offset(0, 1).Value
                        arr(i, 2) = r.Offset(0, 5).Value
                        arr(i, 3) = r.Offset(0, 7).Value
                        arr(i, 4) = r.Offset(0, 8).Value
                        arr(i, 5) = r.Offset(0, 25).Value
                        i = i + 1
                    End If
                Next r
            End With
        End If
    Next ws
    With Sheets(1)
        If i > 0 Then
            .Range("a3").Resize(i, 7).Value = arr
        End If
    End With
End Sub

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Fri Jul 28, 2017 1:14 am
by DhitiBank
suka wrote:ปรับ Code เป็นด้านล่างนี้แล้วเมื่อ Run Code ฟ้องระบายสีเหลืองที่

Code: Select all

If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
ไม่ทราบว่าควรปรับแก้อย่างไรดีคะ
น่าแปลกครับ ผมรันได้ปกติดี ลองดูตามไฟล์แนบครับ ผมปรับโค้ดนิดหน่อยตรงการเลือกชีท แต่ไม่ได้ปรับอะไรตรงบรรทัดที่คุณ suka ติดปัญหาเลยครับ บรรทัดนั้นสั่งให้ตรวจเลขบิล โดยหากเป็นเลขบิลเดิมให้ข้ามไปเลย ไม่ต้องเก็บข้อมูลแถวนั้นในตัวแปรอาร์เรย์ครับ

Code: Select all

... code เดิม...
     For Each ws In Worksheets
        If ws.Name <> Sheets(1).Name And ws.Name <> Sheets(2).Name Then
           With ws
               For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                  If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
                     If r.Value & r.Offset(0, 1).Value & r.Offset(0, 5).Value & r.Offset(0, 7).Value & r.Offset(0, 8).Value & r.Offset(0, 25).Value _
                         Like "*" & s & "*" Then
                         arr(i, 0) = i + 1
                         arr(i, 1) = r.Offset(0, 1).Value
                         arr(i, 2) = r.Offset(0, 5).Value
                         arr(i, 3) = r.Offset(0, 7).Value
                         arr(i, 4) = r.Offset(0, 8).Value
                         arr(i, 5) = r.Offset(0, 25).Value
                         arr(i, 6) = ws.Name
                         i = i + 1
                     End If
                  End If
              Next r
           End With
        End If
    Next ws
 ... code เดิม ...

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Fri Jul 28, 2017 9:43 am
by suka
:thup: ปรับใช้โค้ดด้านล่างนี้นำโค้ดของอาจารย์ปรับให้และนำโค้ดของคุณ DhitiBank ใส่เข้ามาใช้ได้ผลตรงตามต้องการแล้วค่ะ ขอบพระคุณทั้งสองท่านมาก ๆ ค่ะ

Code: Select all

Sub SearchMultipleSheets()
    Dim arr(999, 6) As Variant, r As Range
    Dim ws As Worksheet, i As Integer, s As Range
    With Sheets(1)
        Set s = .Range("c1")
        .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
        If ws.Name = "´ÙÃÒÂÅÐàÍÕ´" Then
            With ws
                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                 If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
                    If r.Offset(0, 1).Value2 = s.Value2 Then
                        arr(i, 0) = i
                        arr(i, 1) = r.Offset(0, 1).Value
                        arr(i, 2) = r.Offset(0, 5).Value
                        arr(i, 3) = r.Offset(0, 7).Value
                        arr(i, 4) = r.Offset(0, 8).Value
                        arr(i, 5) = r.Offset(0, 25).Value
                        i = i + 1
                    End If
                 End If
                Next r
            End With
        End If
    Next ws
    With Sheets(1)
        If i > 0 Then
            .Range("a3").Resize(i, 7).Value = arr
        End If
    End With
End Sub
DhitiBank wrote:
suka wrote:ปรับ Code เป็นด้านล่างนี้แล้วเมื่อ Run Code ฟ้องระบายสีเหลืองที่

Code: Select all

If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
ไม่ทราบว่าควรปรับแก้อย่างไรดีคะ
น่าแปลกครับ ผมรันได้ปกติดี ลองดูตามไฟล์แนบครับ ผมปรับโค้ดนิดหน่อยตรงการเลือกชีท แต่ไม่ได้ปรับอะไรตรงบรรทัดที่คุณ suka ติดปัญหาเลยครับ บรรทัดนั้นสั่งให้ตรวจเลขบิล โดยหากเป็นเลขบิลเดิมให้ข้ามไปเลย ไม่ต้องเก็บข้อมูลแถวนั้นในตัวแปรอาร์เรย์ครับ
:thup: โค้ดของคุณ DhitiBank ช่วยได้มากเลยค่ะ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Wed Aug 16, 2017 7:58 pm
by suka
รบกวนอาจารย์และเพื่อน ๆ ช่วยเรื่องปรับโค้ดค่ะ
ตัวอย่างไฟล์ต้องการใช้โค้ด AdvancedFilterInv ร่วมกับโค้ด SearchMultipleSheets
เมื่อนำโค้ด AdvancedFilterInv ไปใช้ร่วมกับโค้ด SearchMultipleSheets

ที่ SearchMultipleSheets
ติดตรง If r.Offset(0, 1).Value2 = s.Value2 Then โค้ดนี้ค่ะถูกระบายสีเหลืองค่ะ ไม่ทราบควรปรับอย่างไรค่ะ

ซึ่งตอนนี้ทำได้แค่ใช้โค้ด Set s = Sheets("ค้นหา").Range("a4") โค้ดนี้อยู่ใน SearchMultipleSheets
ค่าที่ได้ยังไม่ใช่ที่ต้องการค่ะ

ตัวอย่างที่ต้องการอยู่ในไฟล์แนบชีท "รายงาน" ระบายสีเหลืองไว้ค่ะ

Code: Select all

Sub AdvancedFilterInv()
        Sheets("กรองข้อมูล").Range("A1:AD20000").ClearContents
        Sheets("Database").Columns("A:AD").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("ค้นหา").Range("A2:G3"), CopyToRange:=Sheets("กรองข้อมูล").Range("A1"), Unique:=False
        Application.Goto reference:="OFFSET(R1C1,COUNTA(C1),0)"
End Sub
และ

Code: Select all

Sub SearchMultipleSheets()
    Dim arr(999, 8) As Variant, r As Range
    Dim ws As Worksheet, i As Integer, s As Range
    With Sheets("รายงาน")
        Set s = Sheets("ค้นหา").Range("a4")
        .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
        If ws.Name = "กรองข้อมูล" Then
            With ws
                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                 If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
                    If r.Offset(0, 1).Value2 = s.Value2 Then
                        arr(i, 0) = i
                        arr(i, 0) = r.Offset(0, 1).Value
                        arr(i, 1) = r.Offset(0, 5).Value
                        arr(i, 2) = r.Offset(0, 7).Value
                        arr(i, 3) = r.Offset(0, 8).Value
                        arr(i, 5) = r.Offset(0, 24).Value
                        arr(i, 6) = r.Offset(0, 25).Value
                        i = i + 1
                    End If
                 End If
                Next r
            End With
        End If
    Next ws
    With Sheets("รายงาน")
        If i > 0 Then
            .Range("b3").Resize(i, 9).Value = arr
        End If
    End With
    Range("F3:F" & Range("H5000").End(xlUp).Row).Formula = "=IF(H3="""","""",SUM(H3-G3))"
End Sub

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Wed Aug 16, 2017 9:31 pm
by snasui
:D ผมไม่พบว่าเป็นปัญหา ช่วยแจ้งขั้นตอนการทำสอบมาอย่างละเอียด จะได้เข้าถึงปัญหาโดยไวครับ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Wed Aug 16, 2017 10:15 pm
by suka
อาจารย์คะ ที่ชีท "รายงาน" ต้องการให้แสดงรายงานตามค่าที่เลือกระบุเงื่อนไขที่ชีท "ค้นหา" ค่ะ

เช่นตัวอย่างในไฟล์แนบเลือกวันที่เริ่ม 1/8/2017 - 2/8/2017 ค่ะ โค้ดยังติดที่เลือกได้แค่วันที่เริ่มต้นค่ะ

Set s = Sheets("ค้นหา").Range("a4")

ใช้ได้แค่โค้ดบรรทัดด้านบนนี้ค่ะ ไม่สามารถนำโค้ดด้านล่างมาปรับใช้ได้ค่ะ

Set s = Sheets("ค้นหา").Range("A2:G3")

ติดตรง If r.Offset(0, 1).Value2 = s.Value2 Then โค้ดนี้ค่ะถูกระบายสีเหลืองค่ะ ไม่ทราบควรปรับอย่างไรค่ะ

ความต้องการจริง ๆ แล้ว อยากนำโค้ดที่ชื่อ AdvancedFilterInv มาใช้แทนที่
    Set s = Sheets("ค้นหา").Range("A2:G3")
ค่ะ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Wed Aug 16, 2017 11:01 pm
by snasui
:D ควรปรับ Code มาตามที่ต้องการเสียก่อน เมื่อผู้ตอบทดสอบจะได้พบว่าเป็นปัญหาตามที่แจ้งมา ไม่ใช่นำ Code ต้นฉบับที่ใช้ได้และยังไม่ได้ปรับให้ตรงกับที่ต้องการมาถามครับ

การกำหนดค่าการค้นหาให้กับตัวแปร s ใน Code เดิมนั้นเป็นการกำหนดค่าเพียงเซลล์เดียว หากกำหนดเป็นช่วงเซลล์จะต้อง Loop เพื่อเปรียบเทียบค่าทีละเซลล์ หรือใช้ Countif เข้ามาช่วยในกรณีต้องการนำค่าใด ๆ ไปค้นหาจากช่วงข้อมูลที่แจกแจงออกมาเป็นแต่รายการ เช่น Link นี้เป็นตัวอย่างการใช้ Countif ครับ http://www.snasui.com/viewtopic.php?t=10091

สำหรับการค้นหาเป็นช่วงวันที่โดยมีการกำหนดวันที่เริ่มต้นและวันที่สิ้นสุดแล้วต้องการค้นหาค่าในช่วงนั้น จะใช้ Countif ไม่ได้ จำเป็นต้อง Loop เข้าไปเปรียบเทียบทีละค่าว่ามากกว่าหรือเท่ากับ วันที่เริ่มต้น และน้อยกว่าหรือเท่ากับ วันที่สิ้นสุด หรือไม่ ซึ่งการ Loop สามารถใช้ For Each...Next ซึ่งมีตัวอย่างมากมาย รวมทั้ง Code นี้ก็มีตัวอย่าง For Each...Next อยู่แล้วเช่นกัน

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Thu Aug 17, 2017 11:17 am
by suka
อาจารย์คะ ได้ลองปรับเพิ่มโค้ดนี้เข้าไปที่โค้ด SearchMultipleSheets แล้ว Run Code Error ฟ้องตามรูปแนบค่ะ
ไม่ทราบควรปรับอย่างไรค่ะ

Code: Select all

 With Sheets("รายงาน")
        Set s = Sheets("ค้นหา").Range("a4")
            For Each s In Sheets("ค้นหา").Range("a4").Value
                If s.Value >= Sheets("ค้นหา").Range("a4").Value Then
                    s.Value = Sheets("ค้นหา").Range("b4").Value
                 End If
            Next s
        .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
เพิ่มเข้ามาใช้ร่วมกับโค้ดด้านล่างค่ะ

Code: Select all

Sub SearchMultipleSheets()
    Dim arr(999, 8) As Variant, r As Range
    Dim ws As Worksheet, i As Integer, s As Range
    With Sheets("รายงาน")
        Set s = Sheets("ค้นหา").Range("a4")
            For Each s In Sheets("ค้นหา").Range("a4").Value
                If s.Value >= Sheets("ค้นหา").Range("a4").Value Then
                    s.Value = Sheets("ค้นหา").Range("b4").Value
                End If
            Next s
        .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
        If ws.Name = "กรองข้อมูล" Then
            With ws
                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                 If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
                    If r.Offset(0, 1).Value2 = s.Value2 Then
                        arr(i, 0) = i
                        arr(i, 0) = r.Offset(0, 1).Value
                        arr(i, 1) = r.Offset(0, 5).Value
                        arr(i, 2) = r.Offset(0, 7).Value
                        arr(i, 3) = r.Offset(0, 8).Value
                        arr(i, 5) = r.Offset(0, 24).Value
                        arr(i, 6) = r.Offset(0, 25).Value
                        i = i + 1
                    End If
                 End If
                Next r
            End With
        End If
    Next ws
    With Sheets("รายงาน")
        If i > 0 Then
            .Range("b3").Resize(i, 9).Value = arr
        End If
    End With
    Range("F3:F" & Range("H5000").End(xlUp).Row).Formula = "=IF(H3="""","""",SUM(H3-G3))"
End Sub

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Thu Aug 17, 2017 11:36 am
by suka
รูปบนลืมใส่ End If ค่ะ เอารูปออกไม่ได้ค่ะ พอใส่ End If แล้วฟ้อง Error ตามรูปภาพล่างค่ะ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Thu Aug 17, 2017 5:53 pm
by snasui
:D ค่อย ๆ ถามตอบกันไปครับ

จาก Code For Each s In Sheets("ค้นหา").Range("a4").Value นั้นเป็น Code ที่ไม่ถูกต้อง

การ Loop ลักษณะนี้เป็นการ Loop ไปยังชีตทุกชีต ตัวแปร s หมายถึงแต่ละชีต เพราะฉะนั้น การ Loop แต่ละชีตจะต้อง Loop ไปยัง Collection ของชีต ไม่ใช่ Loop เข้าไปยังค่าของ A4 เช่นที่เขียนมานี้ ช่วยทบทวนการ Loop ลักษณะนี้ใหม่ครับ

นอกจากนี้ควรอธิบายมาใหม่ว่าต้องการจะตรวจสอบค่าใด ตรวจสอบจากที่ใด และผลลัพธ์ที่ต้องการมีลักษณะเป็นอย่างไรจะได้สื่อสารได้ตรงกันครับ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Fri Aug 18, 2017 8:48 pm
by suka
ค่ะอาจารย์

ต้องการจะตรวจสอบค่าจากชีท "ค้นหา" เซลล์ A3:B3 ค่ะ เนื่องจากที่เซลล์ A3:B3 มีสูตร
=IFERROR(">="&(IF($I$3<>"",$I$3,"")&IF($J$3<>"","/"&$J$3,"")&IF($K$3<>"","/"&$K$3,""))+0,"") นี้อยู่ค่ะ
เลยใช้เซลล์ A4:B4 แทนแต่ก็รันโค้ดไม่ได้ค่ะ จากโค้ดด้านล่างถ้าหากใช้แค่ Range("a4") สามารถดึงค่ารายงานมาได้แค่วันที่เริ่มต้นเท่านั้นค่ะ

Set s = Sheets("ค้นหา").Range("a4")

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

Code: Select all

Sub SearchMultipleSheets()
    Dim arr(999, 8) As Variant, r As Range
    Dim ws As Worksheet, i As Integer, s As Range
    With Sheets("รายงาน")
        Set s = Sheets("ค้นหา").Range("a4:b4")
        .Range("b3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
        If ws.Name = "กรองข้อมูล" Then
            With ws
                For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                 If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
                    If r.Offset(0, 1).Value2 = s.Value2 Then
                        arr(i, 0) = i
                        arr(i, 0) = r.Offset(0, 1).Value
                        arr(i, 1) = r.Offset(0, 5).Value
                        arr(i, 2) = r.Offset(0, 7).Value
                        arr(i, 3) = r.Offset(0, 8).Value
                        arr(i, 5) = r.Offset(0, 24).Value
                        arr(i, 6) = r.Offset(0, 25).Value
                        i = i + 1
                    End If
                 End If
                Next r
            End With
        End If
    Next ws
    With Sheets("รายงาน")
        If i > 0 Then
            .Range("b3").Resize(i, 7).Value = arr
        End If
    End With
    Range("F3:F" & Range("H5000").End(xlUp).Row).Formula = "=IF(H3="""","""",SUM(H3-G3))"
End Sub

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Fri Aug 18, 2017 9:46 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

If r.Offset(0, 5).Value <> r.Offset(-1, 5).Value Then
   'If r.Offset(0, 1).Value2 = s.Value2 Then
   If r.Offset(0, 1).Value2 >= s(1).Value2 And r.Offset(0, 1).Value2 <= s(2).Value2 Then
       arr(i, 0) = i
       arr(i, 0) = r.Offset(0, 1).Value
       arr(i, 1) = r.Offset(0, 5).Value
       arr(i, 2) = r.Offset(0, 7).Value
       arr(i, 3) = r.Offset(0, 8).Value
       arr(i, 5) = r.Offset(0, 24).Value
       arr(i, 6) = r.Offset(0, 25).Value
       i = i + 1
   End If
End If

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Sat Aug 19, 2017 9:48 am
by suka
:thup: ขอบคุณอาจารย์มาก ๆ เลยค่ะ ได้ตรงตามที่ต้องการและสามารถเรียกดูรายงานได้รวดเร็วมากค่ะ :cp:

ขอรบกวนให้ช่วยอีก 2 ข้อนะคะ

( 1 ) โค้ดบรรทัดนี้ควรปรับอย่างไรเพื่อให้นำข้อมูลวางแบบ Value ไปที่ชืทรายงานเซลล์ F3 เรียงลงมาเท่าจำนวนข้อมูลที่มีค่ะ Range("F3:F" & Range("H5000").End(xlUp).Row).Formula = "=IF(H3="""","""",SUM(H3-G3))"

( 2 ) ที่ชืทรายงานเซลล์ A3 ต้องการให้โค้ดใส่เลขลำดับที่เท่าจำนวนข้อมูลที่มีเรียงลงมาด้วยค่ะ

ควรปรับเพิ่มโค้ดอย่างไรคะ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Sat Aug 19, 2017 9:53 am
by snasui
:D การจะให้วางเป็น Value ใช้วิธีง่าย ๆ เข้ามาช่วยได้ครับ

หลังจากเขียนสูตรด้วย Code เรียบร้อยแล้วให้ทำการคัดลอกเซลล์ที่เป็นสูตรแล้ววางเป็น Value ก็จะได้คำตอบตามต้องการ การคัดลอกแล้ววางเป็น Value ให้ลองบันทึก Macro แล้วปรับใช้ดูครับ

ส่วน Code ลำดับที่ ลองไปทบทวนว่า Code ต้นฉบับเขียนไว้อย่างไร ควรจะนำโค้ดนั้นมาใช้ได้ครับ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Sat Aug 19, 2017 10:49 am
by suka
ข้อ 1 ได้เพิ่มโค้ดด้านล่างเข้ามาใช้ได้แล้วค่ะ

Code: Select all

 Range("F3:F" & Range("H5000").End(xlUp).Row).Formula = "=IF(H3="""","""",SUM(H3-G3))"
    Range("f3:f" & Range("a5000").End(xlUp).Row).Select
    Selection.Copy
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
ยังติดที่ต้องเพิ่มค่ะ ข้อ 2 ที่ชืทรายงานเซลล์ A3 ต้องการให้โค้ดใส่เลขลำดับที่เท่าจำนวนข้อมูลที่มีเรียงลงมาด้วยค่ะ
ควรปรับเพิ่มได้อย่างไรค่ะ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Sat Aug 19, 2017 11:12 am
by snasui
:D แนบไฟล์ล่าสุดมาใหม่เพื่อจะได้ตอบต่อไปจากนั้นครับ

Re: Code จากคลิป Search data from multiple sheets ค่ะ

Posted: Sat Aug 19, 2017 11:24 am
by suka
แนบไฟล์ล่าสุดค่ะอาจารย์
All times are UTC+07:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited