วางสูตรด้วย vba ค่าที่ได้เป็น false แก้โค้ดอย่างไร

[suka]

เรียนอาจารย์และท่านผู้รู้ช่วยค่ะ

ต้องการวางสูตรที่ชีท Sheet1 คอลัมน์ G แต่ค่าที่วางเป็น false ควรปรับแก้โค้ดอย่างไรคะ
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,""ขาย"")"

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

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

[snasui]

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,""ขาย"")"

เป็นการเขียนที่ไม่ถูกต้อง เราไม่สามารถเขียนให้ Assing ค่าต่อเนื่องกันไปเช่นนั้นได้ครับ ตัวอย่างที่ควรจะเป็น เข่น

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

[suka]

อาจารย์คะ โต้ดติดตามรูปแนบค่ะ ควรปรับแก้อย่างไรคะ

[snasui]

วาง Code ให้อยู่คนละบรรทัดตามตัวอย่างที่ผมแจ้งไป ถ้าว่างต่อเนื่องในบรรทัดเดียวกันลักษณะนั้นจะเกิด Error ครับ

[suka]

ขอบคุณอาจารย์มากค่ะ โค้ดใช้ได้แล้วค่ะ

ขอรบกวนอาจารย์อีกรอบค่ะสูตรในโค้ดค่ะ
สูตรในโค้ดค่ะ ค่าที่วางในคอลัมน์ G ได้มาเป็น 0 ยังติดปรับสูตรไม่ได้ค่ะ

ต้องการตามตัวอย่างไฟล์แนบที่ระบายสีดหลืองค่ะ

[snasui]

ตัวอย่าง Code ครับ

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

[suka]

ขอบคุณอาจารย์มากค่ะ สูตรได้ตรงตามต้องการแล้วค่ะ

อาจารย์คะขอช่วยแปลความหมายของโค้ด

Code: Select all

tt = tt + arr(i, 3)

นี้ค่ะ
ความหมาย tt = 0 ความหมายของ arr(i, 3) คืออะไรคะ?

[snasui]

แปลว่ากำหนดให้ค่าตัวแปร tt มีค่าเท่ากับตัวมันเองบวกกับค่าของตัวแปร arr(i,3) ครับ

[suka]

ขอบคุณมากค่ะอาจารย์