:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

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

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#1

Post 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
You do not have the required permissions to view the files attached to this post.
User avatar
DhitiBank
Gold
Gold
Posts: 1676
Joined: Mon Oct 15, 2012 12:07 am

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

#2

Post 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 อื่นๆ ...
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#3

Post 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
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#4

Post 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
User avatar
DhitiBank
Gold
Gold
Posts: 1676
Joined: Mon Oct 15, 2012 12:07 am

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

#5

Post 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 เดิม ...
You do not have the required permissions to view the files attached to this post.
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#6

Post 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 ช่วยได้มากเลยค่ะ
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#7

Post 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
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#8

Post by snasui »

:D ผมไม่พบว่าเป็นปัญหา ช่วยแจ้งขั้นตอนการทำสอบมาอย่างละเอียด จะได้เข้าถึงปัญหาโดยไวครับ
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#9

Post 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")
ค่ะ
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#10

Post 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 อยู่แล้วเช่นกัน
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#11

Post 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
You do not have the required permissions to view the files attached to this post.
Last edited by suka on Thu Aug 17, 2017 11:44 am, edited 1 time in total.
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#12

Post by suka »

รูปบนลืมใส่ End If ค่ะ เอารูปออกไม่ได้ค่ะ พอใส่ End If แล้วฟ้อง Error ตามรูปภาพล่างค่ะ
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#13

Post by snasui »

:D ค่อย ๆ ถามตอบกันไปครับ

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

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

นอกจากนี้ควรอธิบายมาใหม่ว่าต้องการจะตรวจสอบค่าใด ตรวจสอบจากที่ใด และผลลัพธ์ที่ต้องการมีลักษณะเป็นอย่างไรจะได้สื่อสารได้ตรงกันครับ
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#14

Post 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
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#15

Post 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
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#16

Post by suka »

:thup: ขอบคุณอาจารย์มาก ๆ เลยค่ะ ได้ตรงตามที่ต้องการและสามารถเรียกดูรายงานได้รวดเร็วมากค่ะ :cp:

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

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

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

ควรปรับเพิ่มโค้ดอย่างไรคะ
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#17

Post by snasui »

:D การจะให้วางเป็น Value ใช้วิธีง่าย ๆ เข้ามาช่วยได้ครับ

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

ส่วน Code ลำดับที่ ลองไปทบทวนว่า Code ต้นฉบับเขียนไว้อย่างไร ควรจะนำโค้ดนั้นมาใช้ได้ครับ
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#18

Post 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 ต้องการให้โค้ดใส่เลขลำดับที่เท่าจำนวนข้อมูลที่มีเรียงลงมาด้วยค่ะ
ควรปรับเพิ่มได้อย่างไรค่ะ
User avatar
snasui
Site Admin
Site Admin
Posts: 30736
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

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

#19

Post by snasui »

:D แนบไฟล์ล่าสุดมาใหม่เพื่อจะได้ตอบต่อไปจากนั้นครับ
User avatar
suka
Silver
Silver
Posts: 918
Joined: Tue Nov 16, 2010 7:38 pm
Excel Ver: 2007,2021

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

#20

Post by suka »

แนบไฟล์ล่าสุดค่ะอาจารย์
You do not have the required permissions to view the files attached to this post.
Post Reply