Snasui Excel Forum

Code: Select all

Sub SearchMultipleSheets()
        Dim arr(999, 8) As Variant, r As Range
        Dim ws As Worksheet, i As Integer, s As String
        With Sheets(1)
                s = .Range("c1").Value
                .Range("a3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
        End With
        For Each ws In Worksheets
                If ws.Name <> Sheets(1).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, 2).Value & r.Offset(0, 3).Value & r.Offset(0, 4).Value & r.Offset(0, 5).Value & r.Offset(0, 6).Value _
                                                Like "*" & s & "*" Then
                                                arr(i, 0) = r.Value
                                                arr(i, 1) = r.Offset(0, 1).Value
                                                arr(i, 2) = r.Offset(0, 2).Value
                                                arr(i, 3) = r.Offset(0, 3).Value
                                                arr(i, 4) = r.Offset(0, 4).Value
                                                arr(i, 5) = r.Offset(0, 5).Value
                                                arr(i, 6) = r.Offset(0, 6).Formula = "=SUMIFS(D$3:D3,C$3:C3,B$3:B3,H$3:H3,""ซื้อ"")-SUMIFS(D$3:D3,C$3:C3,$B$3:B3,H$3:H3,""ขาย"")"
                                                arr(i, 7) = ws.Name
                                                i = i + 1
                                        End If
                               Next r
                        End With
                End If
       Next ws
       With Sheets(1)
            .Range("a3").Resize(i, 8).Value = arr
       End With
End Sub

Code: Select all

r.Offset(0, 6).Formula = "=SUMIFS(D$3:D3,C$3:C3,B$3:B3,H$3:H3,""ซื้อ"")-SUMIFS(D$3:D3,C$3:C3,$B$3:B3,H$3:H3,""ขาย"")"
arr(i, 6) = r.offset(0,6).value

Code: Select all

Sub SearchMultipleSheets()
    Dim arr(999, 8) As Variant, r As Range
    Dim ws As Worksheet, i As Integer, s As String
    Dim tt As Double
    With Sheets(1)
        s = .Range("c1").Value
        .Range("a3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    tt = 0
    For Each ws In Worksheets
        If ws.Name <> Sheets(1).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, 2).Value & r.Offset(0, 3).Value & r.Offset(0, 4).Value & r.Offset(0, 5).Value & r.Offset(0, 6).Value _
                        Like "*" & s & "*" Then
                        arr(i, 0) = r.Value
                        arr(i, 1) = r.Offset(0, 1).Value
                        arr(i, 2) = r.Offset(0, 2).Value
                        arr(i, 3) = r.Offset(0, 3).Value
                        arr(i, 4) = r.Offset(0, 4).Value
                        arr(i, 5) = r.Offset(0, 5).Value
                        If ws.Name = "ซื้อ" Then
                            tt = tt + arr(i, 3)
                        Else
                            tt = tt - arr(i, 3)
                        End If
                        arr(i, 6) = tt 'r.Offset(0, 6).Value
                        arr(i, 7) = ws.Name
                        i = i + 1
                    End If
                Next r
            End With
        End If
    Next ws
    With Sheets(1)
        .Range("a3").Resize(i, 8).Value = arr
    End With
End Sub

Code: Select all

tt = tt + arr(i, 3)