توابع تبدیل متغیرها در vba

[~M*E*H*D*I~]

درود

یکی از دوستان سوالی طرح کردند در مورد محاسبات در vba ، نکته ای که باید توجه کرد مقادیر وارد شده در تکست باکس ها به صورت استرینگ هست و غیر قابل محاسبه و باید به integer یا double تبدیل بشن تا قابل محاسبه بشن ، به طور کلی توابع تبدیل مقادیر به یکدیگر به شرح زیر هستند.

CBool(expression)
CByte(expression)
CChar(expression)
CDate(expression)
CDbl(expression)
CDec(expression)
CInt(expression)
CLng(expression)
CObj(expression)
CSByte(expression)
CShort(expression)
CSng(expression)
CStr(expression)
CUInt(expression)
CULng(expression)
CUShort(expression 

)

[حسینعلی]

به نظرمن نیازی به تبدیل نیست.درمحاسبات بین تکست باکس ولیبل ها حذف وایجاد فرمت مقادیر کفایت کرده وجواب میده

 Label(i).caption=format(label1.caption),"")+format(label2.caption),"") 

[armey]

سلام و عرض ادب خدمت دوستان عزیز و اعضای محترم
در خصوص تبدیل
حروف عربی "ی" و "ک" به فارسی
کاربر حرفه ایی و عزیز جناب "iranweld

"
زحمت کشیدند کد

Sub arabibefarsi()  
    
    For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
        cell.Value = WorksheetFunction.Trim(cell)
    
    


    Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Next cell
    
 


 End Sub




[CENTER][COLOR=#414141][/COLOR][/CENTER]

رو در اختیار بنده گذاشتند

سوالم اینه اگه بخوام
این رو
محدود به یک ستون کنم
یا بست بدم به
کل ورکبوک

چه سطری رو باید چه تغییری بدم

فکر میکنم کند هست میخوام محدودش کنم تا سریع تر بشه
و در انتهای کار که فرصت هست برای کل ورکبوک انجام بشه



***سوال دیگه اینه که چجوری میتونم اسم ماژول رو در صفحه ویزوال عوض کنم

[armey]

عرض ادب خدمت دوستان
با راهنمایی های عضو حرفه ایی انجمن "iranweld"


کدی جهت

انتقال مقداری (copy>>>paste value)
اطلاعات

سطرهای یک شیت
به شرط حاوی اطلاعات بودن سلولی مشخص(از نظر مقداری غیر از صفر)
***نکته اینکه اطلاعات سلول مورد نظر با فرمول لوکعاپ وارد می شود

به انتهای شیت دیگری


تهیه شد

Sub copyErsalruzbiKol()

Z = Sheet43.Cells(Sheet43.Rows.Count, "A").End(xlUp).Row
o = Sheet18.Cells(Sheet18.Rows.Count, "A").End(xlUp).Row + 1


For o = 2 To Z


If Sheet43.Range("i" & o) <> "0" Then


Sheet43.Range("A" & o & ":w" & o).Copy Destination:=Sheet18.Range("A" & o)


o = o + 1




End If
Next


Sheet18.Select


End Sub

نام شیتها رو تغییر دادم
فایل اصلی بسیار حجیم بود
فایل نمونه ایی درست کردم دوست عزیز و عضو حرفه ایی iranweld
کد را تهیه نمود و در فایل تست کد کار می کرد

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

فایل رو هم پیوست میکنه
فقط نکته اینکه
در شیت ارسال روز اطلاعات تماما با فرمول لوکعاپ فراخوانی میشود که برای سبک شدن فرمول ها پاک شده

/home/uplooder/public_html/cgi-bin/script-logs.log
Address

با سپاس و تجدید احترام

[iranweld]

با سلام

فایل شما قابل دانلود نیست

- - - Updated - - -

سلام و عرض ادب خدمت دوستان عزیز و اعضای محترم
در خصوص تبدیل
حروف عربی "ی" و "ک" به فارسی
کاربر حرفه ایی و عزیز جناب "iranweld

"
زحمت کشیدند کد

Sub arabibefarsi()  
    
    For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
        cell.Value = WorksheetFunction.Trim(cell)
    
    


    Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Next cell
    
 


 End Sub

رو در اختیار بنده گذاشتند

سوالم اینه اگه بخوام
این رو
محدود به یک ستون کنم
یا بست بدم به
کل ورکبوک

چه سطری رو باید چه تغییری بدم

فکر میکنم کند هست میخوام محدودش کنم تا سریع تر بشه
و در انتهای کار که فرصت هست برای کل ورکبوک انجام بشه



***سوال دیگه اینه که چجوری میتونم اسم ماژول رو در صفحه ویزوال عوض کنم

[ATTACH=CONFIG]23198[/ATTACH]

محدوده رنج رو به ستون مورد نظر تغییر بدید

Sub arabibefarsi()

Set Rng = Sheet1.Range("A1:A10000")
    
    For Each cell In Rng
    
        cell.Value = WorksheetFunction.Trim(cell)
   
    Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Next cell


 End Sub

[armey]

با سلام

فایل شما قابل دانلود نیست

- - - Updated - - -




محدوده رنج رو به ستون مورد نظر تغییر بدید

Sub arabibefarsi()

Set Rng = Sheet1.Range("A1:A10000")
    
    For Each cell In Rng
    
        cell.Value = WorksheetFunction.Trim(cell)
   
    Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        
    Next cell


 End Sub

فایل خدمت شما دوست عزیز

[iranweld]

با سلام

چون شیت و ستون مورد نظر مشخص نبود مطابق تصویر تغییرات مورد نظر را اعمال کنید

[armey]

با سلام

چون شیت و ستون مورد نظر مشخص نبود مطابق تصویر تغییرات مورد نظر را اعمال کنید

[ATTACH=CONFIG]23202[/ATTACH]

خیلی لطف کردید دوست عزیز
تاپیک سوال رو چون خودم زدم "حل شد" بسته شد

تو اجرا دوتا مشکل برام پیش اومد

بابت تبدیل حروف عربی به فارسی که با توضیح شما حل شد
جهت تکمیل و استفاده دوستان فایل رو پیوست میزارم




از بابت انتقال اطلاعات به شیت دیگرد
هم فایل خدمت شما :



* نام ماژول های ایجاد شده رو چجوری باید تغییر بدم ایجاد که میشه به ترتیب شماره میشه نامش ولی گزینه ایی برای تغییر نامش پیدا نمی کنم

[armey]

کد تغییر حروف "ی" و "ک" عربی به فارسی

کد تغییر اینه :

 Cells.Replace What:=ChrW(1610), Replacement:=ChrW(1740), LookAt:=xlPart, SearchOrder _        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=ChrW(1603), Replacement:=ChrW(1705), LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

این قسمت مربوط به آدرس دهی است :

           z1 = Sheet18.Cells(Sheet18.Rows.Count, "A").End(x1up).Row
    Set Rng = Sheet18.Range("A1:A" & z1)
    For Each cell In Rng
    cell.Value = whorksheetFunction.Trim(cell)

*z1 تو خط های کد چه کاری انجام میده؟

[iranweld]

شماره سطر آخرین سلول دارای دیتا را تو ستون مورد نظر میده

[armey]

شماره سطر آخرین سلول دارای دیتا را تو ستون مورد نظر میده

بسیار بسیار سپاسگذارم دوست گرامی و محترم

در خصوص کپی اطلاعات هم راهنمایی بفرمایید ممنونتون میشم

فایل و کدی که شما لطف فرمودید این است :

Sub copyErsalruzbiKol()

Z = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
k = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1


For i = 2 To Z


If Sheet1.Range("A" & i) <> "" Then


Sheet1.Range("A" & i & ":w" & i).Copy Destination:=Sheet2.Range("A" & k)


k = k + 1




End If
Next


Sheet2.Select


End Sub

فایل و کد بنده((شیت مبدا دارای فرمول است که برای نمونه فرمول ها حذف شده اند))

Sub copyErsalruzbiKol()

Z = Sheet43.Cells(Sheet43.Rows.Count, "A").End(xlUp).Row
o = Sheet18.Cells(Sheet18.Rows.Count, "A").End(xlUp).Row + 1


For o = 2 To Z


If Sheet43.Range("i" & o) <> "0" Then


Sheet43.Range("A" & o & ":w" & o).Copy Destination:=Sheet18.Range("A" & o)


o = o + 1




End If
Next


Sheet18.Select


End Sub

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


ممنون میشم راهنمایی بفرمایید