VBA کاربردی: ماکروی اصلاح ی و ک عربی و ارقام فارسی، و نگاهی به Office Scripts

ماکرویی که هر کاربر ایرانی لازم دارد

در فصل ۳ دیدیم که «ي» و «ك» عربی، ارقام فارسی و فاصله‌ی نشکن چطور جست‌وجو و جمع را خراب می‌کنند و با فرمول تمیزشان کردیم. فرمول ستون جدید می‌سازد؛ این ماکرو خود داده را درجا اصلاح می‌کند. این ماکرو را در PERSONAL.XLSB بگذارید تا روی هر فایلی در دسترس باشد.

Option Explicit

' Fix Arabic Yeh/Kaf, Persian/Arabic digits, NBSP and direction marks
' in text constants of the selection (whole sheet if one cell is selected)
Public Sub FixPersianText()
    Dim src As Range, rng As Range, cell As Range
    Dim s As String, n As Long

    If TypeName(Selection) <> "Range" Then Exit Sub
    If Selection.Cells.CountLarge = 1 Then
        Set src = ActiveSheet.UsedRange
    Else
        Set src = Selection
    End If

    On Error Resume Next
    Set rng = src.SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo 0
    If rng Is Nothing Then MsgBox "No text cells.": Exit Sub

    Application.ScreenUpdating = False
    For Each cell In rng.Cells
        s = CleanFa(CStr(cell.Value))
        If s <> cell.Value Then
            If IsPlainNumber(s) Then cell.Value = Val(s) Else cell.Value = s
            n = n + 1
        End If
    Next cell
    Application.ScreenUpdating = True
    MsgBox n & " cells fixed."
End Sub

Private Function CleanFa(ByVal s As String) As String
    Dim i As Long
    s = Replace(s, ChrW(1610), ChrW(1740))      ' Arabic Yeh    -> Persian Yeh
    s = Replace(s, ChrW(1609), ChrW(1740))      ' Alef Maksura  -> Persian Yeh
    s = Replace(s, ChrW(1603), ChrW(1705))      ' Arabic Kaf    -> Persian Kaf
    For i = 0 To 9
        s = Replace(s, ChrW(1776 + i), CStr(i)) ' Persian digits
        s = Replace(s, ChrW(1632 + i), CStr(i)) ' Arabic digits
    Next i
    s = Replace(s, ChrW(1643), ".")             ' Arabic decimal separator
    s = Replace(s, ChrW(1644), "")              ' Arabic thousands separator
    s = Replace(s, ChrW(160), " ")              ' NBSP
    s = Replace(s, ChrW(8206), "")              ' LRM
    s = Replace(s, ChrW(8207), "")              ' RLM
    CleanFa = Application.WorksheetFunction.Trim(s)
End Function

' Digits and at most one dot, no leading zero (keeps 0912... as text)
Private Function IsPlainNumber(ByVal s As String) As Boolean
    If Len(s) = 0 Or Len(s) > 15 Or s = "." Then Exit Function
    If s Like "*[!0-9.]*" Then Exit Function
    If Len(s) - Len(Replace(s, ".", "")) > 1 Then Exit Function
    If Left$(s, 1) = "0" And Len(s) > 1 And Mid$(s, 2, 1) <> "." Then Exit Function
    IsPlainNumber = True
End Function

چرا این‌طور نوشته شده

• SpecialCells(xlCellTypeConstants, xlTextValues) فقط سلول‌های متنی ثابت را برمی‌گرداند؛ فرمول‌ها و اعداد دست‌نخورده می‌مانند.
• IsPlainNumber متن‌هایی مثل «۱۲۵۰۰۰۰» را به عدد واقعی تبدیل می‌کند، اما شماره‌ی موبایل و کد پستی با صفر ابتدا متن می‌مانند.
• Val به‌جای CDbl: Val همیشه نقطه را ممیز می‌داند و به تنظیمات منطقه‌ای ویندوز وابسته نیست.

Office Scripts؛ جانشین VBA در وب

function main(workbook: ExcelScript.Workbook) {
  const range = workbook.getActiveWorksheet().getUsedRange();
  if (!range) return;
  const fix = (s: string) => s
    .replace(/[يى]/g, "ی")
    .replace(/ك/g, "ک")
    .replace(/[۰-۹]/g, d => String(d.charCodeAt(0) - 0x06F0))
    .replace(/[٠-٩]/g, d => String(d.charCodeAt(0) - 0x0660))
    .replace(/ /g, " ").trim();
  const formulas = range.getFormulas();
  const out = formulas.map(row => row.map(v =>
    typeof v === "string" && !v.startsWith("=") ? fix(v) : v));
  range.setFormulas(out);
}

استفاده از getFormulas و setFormulas (به‌جای getValues) تضمین می‌کند فرمول‌ها به مقدار تبدیل نشوند.

نکته‌هایی که کمتر کسی می‌داند

• ویرایشگر VBA یونیکد نیست؛ حروف فارسی داخل کد و کامنت، بسته به تنظیم «Language for non-Unicode programs» ویندوز، به «؟» تبدیل می‌شوند. به همین دلیل حروف را با ChrW می‌سازیم؛ خود داده‌ی سلول‌ها یونیکد کامل است.
• SpecialCells روی یک سلول تنها کل UsedRange شیت را برمی‌گرداند؛ کد بالا این حالت را عمداً و صریح مدیریت می‌کند تا غافلگیر نشوید.
• خواندن و نوشتن سلول‌به‌سلول برای ده‌ها هزار سطر کند است؛ محدوده را یک‌جا در آرایه بخوانید (arr = rng.Value2)، در حافظه پردازش و یک‌جا برگردانید؛ معمولاً ده‌ها برابر سریع‌تر است.
• Value2 برخلاف Value تاریخ و Currency را تبدیل نمی‌کند و سریع‌تر است؛ تاریخ را به‌صورت عدد سریال می‌دهد.