Snasui Excel Forum

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

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

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