[VBA]เขียน Macro ใส่สูตรข้ามไฟล์

[parakorn]

เรียนอาจารย์และเพื่อนๆภายในบอร์ดครับ

ผมเขียนโค้ด ให้ใส่สูตร Array อ้างอิงข้ามไฟล์ และ มีการอ้างอิง Namelist ที่เป็น Dynamic ด้วยครับ
จากโค้ด

Code: Select all

Sub RUnreport()
'
Dim Formula1 As String, Formula2 As String, Formula3 As String
Dim Formula4 As String, Formula5 As String

    Formula1 = "=IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_SVP,FIND("" "",Procedure.xlsm!List_SVP)-1),RC2),0),IFERROR(FIND(Procedure.xlsm!List_SVP,RC2),0))>0,INDEX(Procedure.xlsm!List_SVP,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_SVP,FIND("" "",Procedure.xlsm!List_SVP)-1),RC2),0)>0,0)),R[-1]C4)"
    Formula2 = "=IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_VP,FIND("" "",Procedure.xlsm!List_VP)-1),RC2),0),IFERROR(FIND(Procedure.xlsm!List_VP,RC2),0))>0,INDEX(Procedure.xlsm!List_VP,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_VP,FIND("" "",Procedure.xlsm!List_VP)-1),RC2),0)>0,0)),IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_VP,FIND("" "",Procedure.xlsm!List_VP)-1),RC3),0)" & _
        ",IFERROR(FIND(Procedure.xlsm!List_VP,RC3),0))>0,INDEX(Procedure.xlsm!List_VP,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_VP,FIND("" "",Procedure.xlsm!List_VP)-1),RC3),0)>0,0)),IF(OR(IFERROR(FIND(""Food Hall"",RC1),0),IFERROR(FIND(""Super Store"",RC1),0),IFERROR(FIND(""P-Store"",RC1),0),IFERROR(FIND(""E-Com"",RC1),0)),"""",R[-1]C5)))" & _
        ""
    Formula3 = "=IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_AVP,FIND("" "",Procedure.xlsm!List_AVP)-1),RC2),0),IFERROR(FIND(Procedure.xlsm!List_AVP,RC2),0))>0,INDEX(Procedure.xlsm!List_AVP,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_AVP,FIND("" "",Procedure.xlsm!List_AVP)-1),RC2),0)>0,0)),IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_AVP,FIND("" "",Procedure.xlsm!List_AVP)-1)" & _
        ",RC3),0),IFERROR(FIND(Procedure.xlsm!List_AVP,RC3),0))>0,INDEX(Procedure.xlsm!List_AVP,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_AVP,FIND("" "",Procedure.xlsm!List_AVP)-1),RC3),0)>0,0)),IF(OR(IFERROR(FIND(""Food Hall"",RC1),0),IFERROR(FIND(""Super Store"",RC1),0),IFERROR(FIND(""P-Store"",RC1),0),IFERROR(FIND(""E-Com"",RC1),0)),"""",IF(OR(R[-1]C6=""AVP"",LEFT(" & _
        "RC3,1)=""M""),"""",R[-1]C6))))" & _
        ""
    Formula4 = "=IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_GM,FIND("" "",Procedure.xlsm!List_GM)-1),RC3),0),IFERROR(FIND(Procedure.xlsm!List_GM,RC3),0))>0,INDEX(Procedure.xlsm!List_GM,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_GM,FIND("" "",Procedure.xlsm!List_GM)-1),RC3),0)>0,0)),IF(OR(IFERROR(FIND(""Food Hall"",RC1),0),IFERROR(FIND(""Super Store"",RC1),0),IFERROR(FIND(""" & _
        "P-Store"",RC1),0),IFERROR(FIND(""E-Com"",RC1),0)),"""",IF(R[-1]C7=""GM"","""",IF(ISNUMBER(RC3),R[-1]C7,""""))))" & _
        ""
    Formula5 = "=IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_AM,FIND("" "",Procedure.xlsm!List_AM)-1),RC3),0),IFERROR(FIND(Procedure.xlsm!List_AM,RC3),0))>0,INDEX(Procedure.xlsm!List_AM,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_AM,FIND("" "",Procedure.xlsm!List_AM)-1),RC3),0)>0,0)),IF(OR(IFERROR(FIND(""Food Hall"",RC1),0),IFERROR(FIND(""Super Store"",RC1),0),IFERROR(FIND(""" & _
        "P-Store"",RC1),0),IFERROR(FIND(""E-Com"",RC1),0)),"""",IF(R[-1]C8=""AM,DM"","""",IF(ISNUMBER(RC3),R[-1]C8,""""))))" & _
        ""
    

    Columns("D:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Range("D3") = "SVP,EVP"
        Range("E3") = "VP"
            Range("F3") = "AVP"
                Range("G3") = "GM"
                        Range("H3") = "AM,DM"

    With ActiveSheet.Range("D4")
    .FormulaArray = Formula1
    Selection.Copy
    Application.Goto Reference:="OFFSET(R3C4,2,,COUNTA(C3)-2,)"
    ActiveSheet.Paste
    End With
    
    With ActiveSheet.Range("E4")
    .FormulaArray = Formula2
    Selection.Copy
    Application.Goto Reference:="OFFSET(R3C5,2,,COUNTA(C3)-2,)"
    ActiveSheet.Paste
    End With
    
    With ActiveSheet.Range("F4")
    .FormulaArray = Formula3
    Selection.Copy
    Application.Goto Reference:="OFFSET(R3C6,2,,COUNTA(C3)-2,)"
    ActiveSheet.Paste
    End With
    
    With ActiveSheet.Range("G4")
    .FormulaArray = Formula4
    Selection.Copy
    Application.Goto Reference:="OFFSET(R3C7,2,,COUNTA(C3)-2,)"
    ActiveSheet.Paste
    End With
    
    With ActiveSheet.Range("H4")
    .FormulaArray = Formula5
    Selection.Copy
    Application.Goto Reference:="OFFSET(R3C8,2,,COUNTA(C3)-2,)"
    ActiveSheet.Paste
    End With
    
End Sub

รันแล้วเกิด Error ครับ รายละเอียดตามไฟล์แนบครับ

[snasui]

แนบไฟล์ Procedure.xlsm มาด้วยครับ

[parakorn]

ขออภัยครับ ลืมแก้ชื่อให้เหมือนไฟล์ต้นฉบับ รายละเอียดตามไฟล์แนบครับ

[snasui]

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

Code: Select all

'Other code
Formula1 = "=IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_SVP,FIND("" "",Procedure.xlsm!List_SVP)-1),RC2),0),IFERROR(FIND(Procedure.xlsm!List_SVP,RC2),0))>0,999999,R[-1]C4)"
    Formula11 = "INDEX(Procedure.xlsm!List_SVP,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_SVP,FIND("" "",Procedure.xlsm!List_SVP)-1),RC2),0)>0,0))"
    
    Range("D4").FormulaArray = Formula1
    Range("D4").Replace 999999, Formula11, lookat:=xlPart
'Other code

[parakorn]

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

Code: Select all

'Other code
Formula1 = "=IF(SUM(IFERROR(FIND(LEFT(Procedure.xlsm!List_SVP,FIND("" "",Procedure.xlsm!List_SVP)-1),RC2),0),IFERROR(FIND(Procedure.xlsm!List_SVP,RC2),0))>0,999999,R[-1]C4)"
    Formula11 = "INDEX(Procedure.xlsm!List_SVP,MATCH(TRUE,IFERROR(FIND(LEFT(Procedure.xlsm!List_SVP,FIND("" "",Procedure.xlsm!List_SVP)-1),RC2),0)>0,0))"
    
    Range("D4").FormulaArray = Formula1
    Range("D4").Replace 999999, Formula11, lookat:=xlPart
'Other code

นั่นแทนค่ามันส์เลยครับ ขอบคุณอาจารย์มากๆครับ