特別な重複処理を使用してセルの値に基づいてタブ名を変更するマクロ

Question

シートに一意の名前を付ける式を含むセル値（A4）に基づいてタブ名を変更したマクロがあります。重複がある場合に特別なケース処理を行うことができました。

Sub RenameFromA4() 
Dim Msg As String, i As Integer 
For i = 5 To Sheets.Count 
If Sheets(i).Range("A4").Value = "" Then 
Msg = "Sheet " & i & "(" & Sheets(i).Name & ") has no value in A4. Fix sheet, then rerun." 
MsgBox Msg, vbExclamation 
Exit Sub 
Else 
On Error GoTo ErrSheetName 
Sheets(i).Name = Sheets(i).Range("A4").Value 
On Error GoTo 0 
End If 
Next i 
Exit Sub 
ErrSheetName: Msg = "Sheet " & i & "(" & Sheets(i).Name & ") could not be renamed. Check if name already used." 
MsgBox Msg, vbExclamation 

End Sub 

私はに実行するトラブルが時々重複が発生し、それが完全に停止します私の全体のマクロを実行することができますエラーです。だからここのコードです。だから私は、マクロが重複を検出したときに、セルB3に次の式を追加するシーケンスを追加したいと思います。="IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(":",A2)+2,20))),"")&IF(IFERROR(FIND("West",A2),0)>0," W","")&" "&TRIM(RIGHT(SUBSTITUTE(A2," ",REPT(" ",255)),255))"

エラーを選択するか、マクロを再実行します。

これをどのように構造化できないかについての洞察は役に立ちます。

Answer 1

Test or check if sheet existsのような関数を使用して、B4の値と同じ名前のシートが存在するかどうかを明示的に確認できます。 ``行 `シート（I）.Range（ "B3"）を追加フォーミュラ= "= A4"：ErrSheetName`後のどこか

On Error GoTo ErrSheetName 

If SheetExists(Sheets(i).Range("A4").Value) Then 
    Sheets(i).Range("B3").Formula = "=IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(": ",A2)+2,20))),"")&IF(IFERROR(FIND("West ",A2),0)>0,"W ","")&""&TRIM(RIGHT(SUBSTITUTE(A2,"",REPT("",255)),255))" 
End If 

Sheets(i).Name = Sheets(i).Range("A4").Value