تنظیم یک محدودیت طول در سلول‌ها در اکسل

Question

کریگ در حال توسعه یک کاربرگ است و می خواهد بداند آیا راهی برای تعیین حداکثر تعداد کاراکترهایی که می توان در هر سلول معین وارد کرد وجود دارد یا خیر. او نمی خواهد از Data Validation برای اعمال محدودیت استفاده کند.

هیچ راهی برای انجام این کار به طور مستقیم در اکسل بدون (همانطور که کریگ اشاره می کند) با استفاده از اعتبارسنجی داده وجود ندارد. با این حال، چند چیز وجود دارد که می توانید برای رسیدن به اثر دلخواه تلاش کنید. ابتدا می توانید از یک فرمول برای بررسی طول هر سلول استفاده کنید و در صورت تمایل پیام خطا را نمایش دهید. به عنوان مثال، اگر سلول هایی که می خواهید بررسی کنید در ستون C هستند، می توانید از فرمولی مانند زیر استفاده کنید:

=IF((LEN(C1)>15),"Cell is Too Long","")

فرمول را در سلول سمت راست سلول مورد بررسی قرار دهید (مانند سلول D1)، و سپس آن را به تعداد سلول های لازم کپی کنید. هنگامی که یک ورودی در C1 انجام می شود و اگر بیش از 15 کاراکتر باشد، پیام نمایش داده می شود.

اگر چنین رویکرد مستقیمی نامطلوب است، باید از ماکروها برای بررسی استفاده کنید. مثال زیر یک مثال ساده است که هر زمان که چیزی در کاربرگ تغییر می کند فعال می شود. سپس هر سلول در کاربرگ بررسی می شود تا مطمئن شوید که بیش از 15 کاراکتر نباشد. اگر چنین سلولی کشف شود، یک جعبه پیام نمایش داده می شود و سلول پاک می شود.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    For Each cell In UsedRange
        If Len(cell.Value) > 15 Then
            MsgBox " Cant enter more than 15 characters"
            cell.Value = ""
        End If
    Next
End Sub

یک رویکرد قوی‌تر این است که در کنترل‌کننده رویداد بررسی شود تا ببینیم آیا تغییر در محدوده‌ای از سلول‌هایی که باید از نظر طول محدود شوند، انجام شده است یا خیر.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim rCell As Range
    Dim iChars As Integer
    On Error GoTo ErrHandler

    Change these as desired
    iChars = 15
    Set rng = Me.Range("A1:A10")

    If Not Intersect(Target, rng) Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In Intersect(Target, rng)
            If Len(rCell.Value) > iChars Then
                rCell.Value = Left(rCell.Value, iChars)
                MsgBox rCell.Address & " has more than" _
                  & iChars & " characters." & vbCrLf _
                  & "It has been truncated."
            End If
        Next
    End If

ExitHandler:
    Application.EnableEvents = True
    Set rCell = Nothing
    Set rng = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

برای استفاده از این ماکرو، فقط باید مقدار اختصاص داده شده به iChars (نماینده حداکثر طول مجاز) و محدوده اختصاص داده شده به rng (در حال حاضر روی A1:A10 تنظیم شده است) را تغییر دهید. از آنجایی که ماکرو فقط تغییرات در محدوده مشخص شده را بررسی می کند، با کاربرگ های بزرگتر بسیار سریعتر از ماکروهایی است که تمام سلول های استفاده شده را بررسی می کند.