تبدیل عدد فارسی به انگلیسی

[master]

سلام
یه فایل دارم که تاریخ های داخلش همگی عدد فارسی هستن میخوام توی vba تاریخ ها تبدیل به عدد انگلیسی بشن(فرمت تاریخ هم به صورت yyyy/mm/dd هست)
با چه کدی میشه این کار رو انجام داد؟
البته توی همین انجمن یه تایپیک مشابه همین سواال پیدا کردمتوی ادرس زیر:
[حل شده] تبدیل اعداد فارسی به انگلیسی
که البته کد توی خود سلول اکسل نوشته میشه:
کدش این بود:

=VALUE(MID(B2;1;4))&"/"&VALUE(MID(B2;6;1))&VALUE(MID(B2;7;1))&"/"&VALUE(MID(B2;9;1))&VALUE(MID(B2;10;1)) 

با فرض اینکه تاریخ فارسی در خونه B2 قرار داره کد رو توی خونه C2 نوشتم کار کرد
حالا چطوری میشه این کد رو توی vba استفاده کرد؟ ضمنا من میخوام تغییر در همون خونه ای که تاریخ فارسی قرار داره اتفاق بیافته


جدایی از کد فوق کلا روشی وجود داره که توی یک ستون بگرده هر چی عدد فارسی وجود داره رو تبدیل به عدد انگلیسی کنه؟(یا بلعکس)
کد فوق یه جواریی وابسته به فرمت اون سلول هست و خیلی جالب نیست یه چیزی باشه کل محتویات سلول رو پیمایش کنه و اگه عدد دید چک کنه فارسی هست یا نه اگه بود انگلیسی کنه (برا برعکسشم پیمایش کنه اگه عدد دید ببینه فارسی هست یا نه اگه فارسی بود انگلیسی کنه)
ضمنا من خودم یه اموزش، مشابه چیزی که میخوام دیدم ولی برا من کار نکرد دوستان ببینن مشکل کد چیه و ایا میشه تصحیح کرد تا کار کنه یا نه
اینم ادرس سایتی که اموزش رو قرار داده بود:
تبدیل اعداد انگلیسی به فارسی و بالعکس در نرم افزارهای Word و Excel (اعداد صحیح و اعشاری) [بروز شد] :: ترفندها
خیلی اموزش کامل و جامعی هست ولی نمیدونم کدش چه مشکلی داشت که ارور میداد
با تشکر

ویرایش:
اموزش اون سایت رو مجدد خوندم اون قسمت هایی که کد نویسی داشت بیشتر به درد ورد میخورد برا همین توی اکسل ارور میداد
حالا دوستان کد ها رو ببین میشه تغییرش داد تا توی اکسل هم کار کنه یا نه (هم برا فارسی به انگلیسی داشت و هم برا انگلیسی به فارسی)
چون توضیحات خود سایت خیلی کامل هست کد رو از اونجا ببینید بهتره

[iranweld]

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

Sub Macro1()
'
' Macro1 Macro
'

'
    Cells.Select
    With Selection.Font
        .Name = "Bookman Old Style"
        .Size = 12
        
    End With
    Range("A1").Select
End Sub 

[master]

سلام
با تغییر فونت مشکل حل نمیشه

[iranweld]

سلام
با تغییر فونت مشکل حل نمیشه

فایل پیوست را ملاحظه بفرمایید

[master]

سلام
شما همین کد رو روی فایل من تست کنید
نمیدونم دلیلش چی هست که با تغییر فونت درست نمیشه یعنی عدد ها به چه صورتی توی فایل وارد شدن که درست نمیشن
با تشکر

[smartman]

این ماکرو را اجرا کن

Sub Macro1()

    Range("A:A").Select
    Selection.Replace What:=":", Replacement:=":", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "[$-1000000]h:mm:ss;@"
    Columns("B:C").Select
    Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.NumberFormat = "0"
    Selection.NumberFormat = "####""/""##""/""##"
    Range("A1").Select
End Sub

[master]

سلام
این ماکرو توی این فایل جواب داد اما یه مشکل داره اینکه محتویات سلول b رو تغییر میده در واقع / رو حذف میکنه و فقط توی نمایش فرمت سلول اونا رو نشون میده
البته شاید بشه با تابع خاصی این / رو هم اضافه کرد اما من میخوام به گونه ای باشه که منحصر به فرمت سلول نباشه
مثلا شما توی سلول اول نگاه کردید دیدید فرمت ساعت هست و بعد طبق اون رفتید جلو
اگه به گونه ای باشه که کاری نداشت هباشه فرمت سلول چی هست عالی میشه مثلا توی یه رنج محتویات هر سلول رو چک کنه توی محتویات سلول کارکتر به کارکتر کنترل کنه اگه عدد فارسی بود انگلیسی کنه
نمیدونم میشه خط فوق رو براش کد نوشت یا نه
ضمن اینکه اگه نوشته هم بشه فکر کنم توی داده های خیلی زیاد باید کند عمل کنه درسته؟
با تشکر

[smartman]

مشکل عددها نیستن که کد بنویسیم و اونا رو تبدیل کنه. مشکل اون کاراکترایی هستن که همراه عدد وارد شدن! این نوع مشکلات اغلب زمانی اتفاق میافته که داده ها از یه برنامه دیگه وارد اکسل میشن.

[master]

سلام
خوب موقع چک کردن اون کارکتر های همراه عینا منتقل بشن مشکلی پیش میاره؟یعنی هر چی عدد فارسی نبود همون بمونه!

من یکم گشتم با توجه به چیزایی که خوندم باید این کد محتویات رنج مورد نظر رو اگه عدد فارسی داره انگلیسی کنه اما برا من کار نکرد
البته با توجه به اینکه خیلی تو زمینه نوشتن کد وارد نیستم میخواستم بدونم تابع ایراد داره؟

Sub Macro1()

    Dim s As String
    Dim i As Integer
    Dim C As Range
    Dim ch As String
    Dim s1 As String
    
    
    For Each C In Range("B:C")
    s1 = ""
    s = C.Value

    For i = 1 To Len(s)
        ch = Mid(s, i, 1)
        If 1728 <= Asc(ch) And Asc(ch) <= 1737 Then
        ch = ChrW(Asc(ch) - 1680)
        End If
        s1 = s1 + ch
        
    Next i
    C.Value = s1
    
    If Len(s) = 0 Then
    Exit For
    End If
    Next

End Sub 

جالب اینکه کد برعکس این کد یعنی تبدیل عدد های انگلیسی به فارسی رو تست کردم کار کرد!!!
حتی توی یه سلول حروف انگلیسی وارد کردم و بین اونا عدد انگلیسی گذاشتم وقتی کد رو اجرا کردم همه عدد های انگلیسی رو فارسی کرد به بقیه کارکتر ها هم کاری نداشت!!! یعنی دقیقا همون چیزی که من میخوام ولی نمیدونم چرا کد فارسی به انگلیسی کار نمیکنه

اینم کد برعکس که کار میکنه:

Sub Macro1()

    Dim s As String
    Dim i As Integer
    Dim C As Range
    Dim ch As String
    Dim s1 As String
    
    
    For Each C In Range("G:G")
    s1 = ""
    s = C.Value

    
    For i = 1 To Len(s)
        ch = Mid(s, i, 1)
        If 48 <= Asc(ch) And Asc(ch) <= 57 Then
        ch = ChrW(Asc(ch) + 1728)
        End If
        s1 = s1 + ch
        
    Next i
    C.Value = s1
    
    If Len(s) = 0 Then
    Exit For
    
    End If
    Next

End Sub 

[master]

سلام
خودم با کد زیر حلش کردم:

    Dim s As String
    Dim ch As String
    Dim s1 As String
    Dim RowNumber As Integer
    
    RowNumber = ActiveSheet.Range("G65536").End(xlUp).Row
    
    For Each C In Range("F:F")
    s1 = ""
    s = C.Value

        For i = 1 To Len(s)
        ch = Mid(s, i, 1)
        If 1776 <= AscW(ch) And AscW(ch) <= 1785 Then
        ch = ChrW(AscW(ch) - 1728)
        End If

        s1 = s1 + ch
        Next i
    C.Value = s1
    
    If C.Row = RowNumber Then
    Exit For
    End If
    Next C 

الان تو محدوده مورد نظر که توی این کد F:F در نظر گرفته کل محتویات سلول ها رو پیمایش میکنه اگه عدد فارسی داخلشون باشه با معادل انگلیسیش جابجا میکنه
با تشکر