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

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

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

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

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

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