هزار و یک شب اکسل - شب بیست و سوم - کدی برای معرفی فرمول های بکار رفته در یک شیت اکتیو

[امين اسماعيلي]

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



Sub ListFormulas()
Dim FormulaCells As Range
Dim FormulaSheet As Worksheet
Dim Row As Long
Dim Cell As Range
On Error Resume Next
Set FormulaCells = Range(“A1”).SpecialCells(xlFormulas, 23)
If FormulaCells Is Nothing Then Exit Sub
Set FormulaSheet = ActiveWorkbook.Worksheets.Add
Row = 1
For Each Cell In FormulaCells
With FormulaSheet
Cells(Row, 1) = Cell.Address(False, False)
Cells(Row, 2) = “ “ & Cell.Formula
Cells(Row, 3) = Cell.Value
Row = Row + 1
End With
Next Cell
End Sub



کد بالا را در یک ماژول کپی کنین به این صورت که Alt+F11 و سپس insert/module رو بزنین و عینانا کد رو کپی کنین . حال هر شیتی رو که میخواین فرمول هاشو داشته باشین در حالت اکتیو قرار داده و Alt+F8 رو بزنین یا از تب developer گزینه Macro رو انتخاب و از پنجره ظاهر شده نام ListFormulas رو کایک و اکی کنید با این کار یه شیت جدید ایجاد میشه و در ستون اول اون ادرس فرمول در ستون دوم خود فرمول و در ستون سوم نتیجه فرمول میاد .
حالا یه تکلیف مخصوصا اونایی که با VBA کار کردن . کد بالا رو طوری تغییر بدین که یهشیت مثلا به نام Formula Print قبل دارین همیشه این شیت اول خالی بشه و بعد اون شیت اکتیو که این کد رو از اونجا run میکنیم تمام فرمولاش بیاد . یعنی هی الکی شیت تولید نشه.
شب همتون خوش خیلی دوستون دارم شبتون به قول بچه ها شیک و مجلسی . به قول خودم رنگی رنگی

تنبل بازی در نیارینا . یه تمرین قبلا دادم که انجام نشده ،تو یکی از داستانا که میخواستیم ردیف رو برام تو define manage name یا همون نامگذاری محدوده پویاش بکنیم یادتون اومد یا نههههههه اونم انجام بدین. اونایی که زیاد با ویبی کار نکردن عذرشون تو این قصه موجهه اما از بقیتون انتظار دارم .........

[Nima]

با تشکر از زحمات جنابعالی و بقیه دوستان
برای اینکه ببینیم که شیت مورد نظر موجود هست یانه باید از یک حلقه برای چک کردن این موضوع استفاده کنیم البته بنده فضولی کردم کد شما رو اینطوری نوشتم:) :


Sub ListFormulas()
Dim FormulaCells As Range
Dim FormulaSheet As Worksheet
Dim Row As Long
Dim Cell As Range
On Error Resume Next
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
If FormulaCells Is Nothing Then Exit Sub
If Sheets("FormulaSheet") Is Nothing Then
Sheets.Add
ActiveSheet.Name = "FormulaSheet"
Sheets("FormulaSheet").Select
ElseIf Not Sheets("FormulaSheet") Is Nothing Then
Sheets("FormulaSheet").Select
Sheets("FormulaSheet").Cells.ClearContents
End If
Row = 1
For Each Cell In FormulaCells
With FormulaSheet
Cells(Row, 1) = Cell.Address(False, False)
Cells(Row, 2) = " " & Cell.Formula
Cells(Row, 3) = Cell.Value
Row = Row + 1
End With
Next Cell
End Sub

[امين اسماعيلي]

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