تغییر نام کاربرگ ها بر اساس فهرست در اکسل

Question

گیلبرت دارای یک کاربرگ (به نام "کنترل") است که حاوی لیستی از نام های کاربرگ مورد نظر در سلول های A1:A12 است. او به روشی در یک ماکرو نیاز دارد تا هر یک از 12 کاربرگ دیگر را در کتاب کار بر اساس آن محدوده سلول ها تغییر نام دهد. نام کاربرگ ها لازم نیست پویا باشند. زمانی که او ماکرو را اجرا می کند فقط باید نام آنها را تغییر داد.

هسته اصلی توسعه یک ماکرو برای رفع این نیاز، تکیه بر ویژگی Name هر کاربرگ است که می‌خواهید نام آن را تغییر دهید. به عنوان مثال، می توانید از یک ماکرو بسیار ساده مانند زیر استفاده کنید:

Sub RenameSheets()
    Dim c As Range
    Dim J As Integer

    J = 0
    For Each c In Range("A1:A12")
        J = J + 1
        If Sheets(J).Name = "Control" Then J = J + 1
        Sheets(J).Name = c.Text
    Next c
End Sub

ماکرو به سادگی از محدوده سلولی A1:A12 عبور می کند و اگر کاربرگ بعدی "کنترل" نام ندارد، کاربرگ را به مقدار سلول تغییر نام می دهد.

همانطور که اشاره شد، این ماکرو بسیار ساده است و به احتمال زیاد باید بسیار قوی تر باشد. به عنوان مثال، اگر بیشتر (یا کمتر) از 13 کاربرگ در کتاب کار فعلی وجود داشته باشد، چه کاری باید انجام شود؟ در صورت وجود سلول های خالی در محدوده A1:A12 چه باید کرد؟ اگر کسی ماکرو را اجرا کند و "کنترل" کاربرگ فعال نباشد، چه باید کرد؟ اگر دو مقدار یکسان در A1:A12 وجود داشته باشد چه باید کرد؟ اگر روی یک یا چند نام در محدوده A1:A12 فضاهای پیشرو یا انتهایی وجود داشته باشد، چه؟ اینها و (به احتمال زیاد) طیف کاملی از سؤالات دیگر می توانند بر ظاهر ماکرو تأثیر بگذارند. در اینجا یک نسخه نظری از ماکرو است که چندین مورد از احتمالات ذکر شده را در نظر می گیرد:

Sub RenameSheets()
    Dim c As Range
    Dim J As Integer
    Dim K As Integer
    Dim sName As String
    Dim w(12) As String
    Dim bGo As Boolean
    Dim sTemp As String

    bGo = True
    If Worksheets.Count <> 13 Then
         Check to make sure exactly 13 worksheets in workbook
        bGo = False
        sTemp = "There are more than 13 worksheets."
    End If
    If ActiveSheet.Name <> "Control" Then
         Check to make sure Control is active
        bGo = False
        sTemp = "Control worksheet is not active."
    Else
         Check for empty and duplicate cells in range
        J = 0
        For Each c In Range("A1:A12")
            sName = Trim(c.Text)
            If sName <> "" Then
                For K = 1 to J
                    If LCase(w(K)) = LCase(sName) Then
                        bGo = False
                        sTemp = "Duplicate sheet names in list."
                    End If
                Next K
                If bGo Then
                     Everything still good; add name
                    J = J + 1
                    w(J) = sName
                End If
            End If
        Next c
    End If

    If bGo Then
        K = 0
        For J = 1 To 12
            K = K + 1
            If Sheets(K).Name = "Control" Then K = K + 1
            Sheets(K).Name = w(J)
        Next J
    Else
        MsgBox(sTemp)
    End If
End Sub

توجه کنید که نسخه دوم ماکرو چقدر طولانی تر از نسخه اول است؟ هر زمان که شروع به اضافه کردن چک های متعدد در یک ماکرو کنید، واقعاً می تواند آن را بسیار طولانی تر از بدون چک کند. البته مزیت اضافه کردن چک‌ها این است که ماکرو شما کمتر با مشکل مواجه می‌شود زیرا توسط افرادی غیر از شما استفاده می‌شود.