Snasui Excel Forum

Code: Select all

With Sheets("รายงาน")
        If i > 0 Then
            .Range("a3").Resize(i, 8).Value = arr
        End If
End With

Code: Select all

Sub SearchMultipleSheets()
    Dim arr(999, 9) 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
                    If r.Offset(0, 1).Value2 >= s(1).Value2 And r.Offset(0, 1).Value2 <= s(2).Value2 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, 6) = r.Offset(0, 24).Value
                        arr(i, 7) = 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, 8).Value = arr
        End If
    End With
    Range("g3:g" & Range("i5000").End(xlUp).Row).Formula = "=IF(i3="""","""",SUM(i3-h3))"
    Range("g3:g" & Range("b5000").End(xlUp).Row).Select
    Selection.Copy
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Code: Select all

If r.Offset(0, 1).Value2 >= s(1).Value2 And r.Offset(0, 1).Value2 <= s(2).Value2 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, 24).Value
    arr(i, 6) = r.Offset(0, 25).Value
    i = i + 1
End If

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

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

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

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

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

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

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 เดิม ...