Uzun formül dizesi alma

Question

Çalışma sayfasındaki belirli senaryoları işlemek için uzun bir formül oluşturmak zorunda kalmadan mükemmel şekilde çalışan bir makro vardı. Formül temel olarak metinden bir isim oluşturur, ben devam edip hücrenin sekmesini bu isimle yeniden adlandırıyorum. Ben dize arada kullanabilirsiniz bir yolu yoktur

=IF(A1="Facility Variance Report",IF(MID(A2,FIND(":",A2)+2,20)="Baptist Memorial Hos",MID(A2,FIND("_",A2)+1,2)&"-"&TRIM((MID(A2,FIND(":",A2)+2,17)))&IF(IFERROR(FIND("West",A2),0)>0," W","")&" "&MID(A2,FIND(CHAR(1),SUBSTITUTE(A2,"-",CHAR(1),2))+1,3)&" -FVar",MID(A2,FIND("_",A2)+1,2)&"-"&MID(A2,FIND("_",A2)+1,2)&"-"&TRIM((MID(A2,FIND(":",A2)+2,20)))&IF(IFERROR(FIND("West",A2),0)>0," W","")&"-FVar"),IF(MID(A2,FIND(":",A2)+2,20)="Baptist Memorial Hos",MID(A2,FIND("_",A2)+1,2)&"-"&TRIM((MID(A2,FIND(":",A2)+2,17)))&IF(IFERROR(FIND("West",A2),0)>0," W","")&" "&MID(A2,FIND("-",A2,FIND("-",A2)+1)+1,3)&"-LTM",MID(A2,FIND("_",A2)+1,2)&"-"&MID(A2,FIND("_",A2)+1,2)&"-"&TRIM((MID(A2,FIND(":",A2)+2,20)))&IF(IFERROR(FIND("West",A2),0)>0," W","")&"-LTM")) 

Ben yardım gerekir: Burada

Sub Tab_Name_Creation() 
Dim s As Worksheet 
Dim formula As String 
For Each s In ActiveWorkbook.Worksheets 

    s.Activate 
    With ActiveWindow 
     .View = xlNormalView 
    End With 

Next s 
Call UnhideRows 
formula = "= IF(R[-3]C=""Facility Variance Report"",IF(MID(R[-2]C,FIND("":"",R[-2]C)+2,20)=""Baptist Memorial Hos"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,17)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&"" ""&MID(R[-2]C,FIND(""-"",R[-2]C,FIND(""-"",R[-2]C)+1)+1,3)&""-FVar"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&MID(R[-2]C,FIN" & _ 
    "R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,20)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&""-FVar""),IF(MID(R[-2]C,FIND("":"",R[-2]C)+2,20)=""Baptist Memorial Hos"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,17)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&"" ""&MID(R[-2]C,FIND(""-"",R[-2]C,FIND(""-" & _ 
    ")+1)+1,3)&""-LTM"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,20)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&""-LTM""))" 

For i = 5 To ThisWorkbook.Worksheets.Count 
    Worksheets(i).Range("A4").NumberFormat = "General" 
    Worksheets(i).Range("A4") = formula 
Next i 

Call RenameFromA4 
Call SortWorkBook 
Call listsheets 
MsgBox "Report Has Been Updated" 
End Sub 

formül şu şekildedir: İşte vba kodu? Ya da formülü yoğunlaştırmanın bir yolunu bulmak zorunda mıyım?

Answer 1

Tut basitçe sadece ihtiyacınız olanı kod ve neticeyi bırakabilirsiniz zaman formula = formula + "text"

Sub Tab_Name_Creation() 
Dim s As Worksheet 
Dim formula As String 
For Each s In ActiveWorkbook.Worksheets 

    s.Activate 
    With ActiveWindow 
     .View = xlNormalView 
    End With 

Next s 
Call UnhideRows 
formula = "=IF(R[-3]C=""Facility Variance Report"",IF(MID(R[-2]C,FIND("":"",R[-2]C)+2,20)=""Baptist Memorial Hos"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,17)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&"" ""&MID(R[-2]C,FIND(""-"",R[-2]C,FIND(""-"",R[-2]C)+1)+1,3)&""-FVar"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&MID(R[-2]C,FIN" 
formula = formula + "R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,20)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&""-FVar""),IF(MID(R[-2]C,FIND("":"",R[-2]C)+2,20)=""Baptist Memorial Hos"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,17)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&"" ""&MID(R[-2]C,FIND(""-"",R[-2]C,FIND(""-" 
formula = formula + ")+1)+1,3)&""-LTM"",MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&MID(R[-2]C,FIND(""_"",R[-2]C)+1,2)&""-""&TRIM((MID(R[-2]C,FIND("":"",R[-2]C)+2,20)))&IF(IFERROR(FIND(""West"",R[-2]C),0)>0,"" W"","""")&""-LTM""))" 

For i = 5 To ThisWorkbook.Worksheets.Count 
    Worksheets(i).Range("A4").NumberFormat = "General" 
    Worksheets(i).Range("A4") = formula 
Next i 

Call RenameFromA4 
Call SortWorkBook 
Call listsheets 
MsgBox "Report Has Been Updated" 
End Sub