สอบถามการ Run macro เฉพาะ sheet ที่เลือก แต่สูตรไม่มาด้วย.

[xoathx]

สวัสดีครับ พอดีผมมีปัญหาคือพยายามทำสูตร vlookup ด้วย macro ครับ แต่จะแบ่งเป็นเฉพาะแต่ละชีทไป เช่น sheet นี้จะต้อง vlookup ข้อมูลจากช่อง 3 อีก sheet ต้อง vlookup ข้อมูลจากช่อง 4 เป็นต้นครับ.
ทีนี้ผมลอง Record macro แล้วนำมาแก้ แต่พบว่าไม่สามารถใช้งานได้ครับ จึงได้ปรับเปลี่ยนไปมาจนได้เป็นสูตรตามนี้ครับ แต่ยังติดปัญหา vlookup แล้วข้อมูลไม่มาครับ และ sheet ที่เลือก ข้อมูลไม่เดิมลงไปในช่องครับ จึงเรียนขอความช่วยเหลืออาจารย์ครับ.

Code: Select all

Sub Test2()
'
' Test Macro
'

'
    Dim lastrow As Long
    Sheets(Array("M880(C)", "M553(C)", "M551(C)", "M577(C)")). _
        Select
    Sheets("M880(C)").Activate
    Range("BY4") = "=VLOOKUP(BY4,'Z:\Toner Tacking report 2018\BUMRUNGRAD (BIH)\[WJA_BIH.csv]WJA_BIH'!C:I,4,0)"
    Range("BZ4") = "=VLOOKUP(BY4,'Z:\Toner Tacking report 2018\BUMRUNGRAD (BIH)\[WJA_BIH.csv]WJA_BIH'!C:I,7,0)"
    Range("BY4:BZ4").Select
    Selection.AutoFill Destination:=Range("BY4:BZ4" & lastrow)
    Range("BY4:BZ4" & lastrow).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("BW1:BX3").Select
    Selection.Copy
    Range("BY1").Select
    ActiveSheet.Paste
    Range("BY1:BZ1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "6/8/2019"
    Range("BY1:BZ1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("BY1:BZ1").Select
End Sub

[snasui]

กรุณาแนบไฟล์ตัวอย่างมาด้วยและควรอธิบายมาด้วยว่าหากทำงานถูกต้องคำตอบจะเป็นอย่างไรครับ

[xoathx]

ผลที่ออกมาผิดครับ.สูตรจะออกมาเป็น 0 และใน sheet ที่เหลือไว้ ก็ไม่แสดงค่าครับ แสดงเพียงชีทแรกครับ.



แบบที่ต้องการครับ ทุกชีทที่เลือกจะแสดงผลลัพธ์ออกมาครับ.พร้อมทั้งจะแสดงผลลัพธ์ถึงแค่ cell สุดท้ายครับ.



Macro ที่ใช้ตอนนี้คือชื่อ Test ครับ.

Serial BIH Check Toner.xlsm

(323.85 KiB) Downloaded 7 times

WJA_BIH.xlsx

(51.58 KiB) Downloaded 7 times

[snasui]

ตัวอย่าง Code การ Loop เพื่อทำงานกับแต่ละชีตครับ

Code: Select all

Sub Test()
'
' Test Macro
'

'
    
    Dim lastrow As Long
    Dim s As Worksheet
    For Each s In Sheets(Array("M880(C)", "M553(C)", "M551(C)", "M577(C)"))
        lastrow = s.Range("BY" & s.Rows.Count).End(xlUp).Row
        s.Activate
        s.Range("BY4") = "=VLOOKUP(BY4,'Z:\Toner Tacking report 2018\BUMRUNGRAD (BIH)\[WJA_BIH.csv]WJA_BIH'!C:I,4,0)"
        s.Range("BZ4") = "=VLOOKUP(BY4,'Z:\Toner Tacking report 2018\BUMRUNGRAD (BIH)\[WJA_BIH.csv]WJA_BIH'!C:I,7,0)"
        s.Range("BY4:BZ4").Select
        Selection.AutoFill Destination:=Range("BY4:BZ" & lastrow)
        s.Range("BY4:BZ" & lastrow).Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        s.Range("BW1:BX3").Select
        Selection.Copy
        s.Range("BY1").Select
        ActiveSheet.Paste
        s.Range("BY1:BZ1").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "6/8/2019"
        s.Range("BY1:BZ1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        s.Range("BY1:BZ1").Select
    Next s
End Sub

[xoathx]

ขอบพระคุณอาจารย์ครับ ตอนนี้นำไปปรับใช้ได้เรียบร้อยแล้วครับ.