پرسش ماکروی مینیم بدون لحاظ صفر

[naser1357]

در ماکرویی که نوشتم برای مینیمم گیری

sheet3.Cells(i, "F").Value = Application.WorksheetFunction.Min(sheet4.Range(sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j)))

متاسفانه عدد صفر لحاظ می کند
در تابع از این شرط استفاده می کنم

SMALL(A1:A100,COUNTIF(A1:A100,0)+1)

حال هر کاری می کنم خطا می ده ممنون میشوم تابع را بصورت ماکرو همانند ماکروی بالا در اورید؟
یعنی ماکرو فقط مینیمم بزرگتر از 10 را نشان بدهد

[Amir Ghasemiyan]

سلام دوست عزیز
میتونید از این کد استفاده کنید

Sheet3.Range("F" & i).Formula = "=SMALL(A1:A100,COUNTIF(A1:A100,0)+1)"

فرق این روش با روشی که شما نوشتید در این هست که این کد باعث میشه فرمول همیشه باقی بمونه ولی در روش شما محاسبه انجام میشه و فقط مقدار وارد میشه
اگر این روش که انجام دادم به کار شما نمیاد بفرمایید تا براتون با روش خودتون انجام بدم

[naser1357]

سلام
ضمن تشکر اگر امکان دارد بصورت ماکرو با این فرمت ارایه شود
sheet3.Cells(i, "F").Value = Application.WorksheetFunction.Min(sheet4.Range(she et4.Cells(nn, j), sheet4.Cells(lastrow4, j)))

[Amir Ghasemiyan]

من چون فايل شما رو ندارم تست نكردم
بررسي بفرماييد اين كد جواب ميده يا خير

Sheet3.Range("F" & i).Value = Application.WorksheetFunction.Small(Range("A1:A100"), Application.WorksheetFunction.CountIf(Range("A1:A100"), 0) + 1)

[naser1357]

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

[naser1357]

عذر میخام این سوال هم اینجا می پرسم بجای ایجاد موضوع
در تابع وقتی میانگین می گیرم درست محاسبه می شود
اما در ماکرو برای برخی سلول ها علامت

#div/0! ظاهر میشود برای این راه حلی هست؟

[naser1357]

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


- - - Updated - - -


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

[M_ExceL]

-
سلام
وقتی از کد بالا استفاده میکنم این خطا طاهر میشود
[ATTACH=CONFIG]20211[/ATTACH]

- - - Updated - - -

[ATTACH=CONFIG]20212[/ATTACH]
این خطا اهر می شود وقتی از کد بالا استفاده می کنم

سلام،
این رو تست کنید :

Sub test()
Sheets(1).Range("b1") = Application.WorksheetFunction.Small(Range("A1:A100"), Application.WorksheetFunction.CountIf(Range("A1:A100"), 0) + 1)
End Sub

نکته : شماره شیت و رنج رو می تونید تغییر بدید.

[naser1357]

سلام
متاسفانه همون خطا میده
sheet3.Cells(i, "F").Value = Application.WorksheetFunction.Small(sheet4.Range(s heet4.Cells(nn, j), sheet4.Cells(lastrow4, j)), Application.WorksheetFunction.CountIf(sheet4.Range (sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j)), 0) + 1)
کد اصلی به اینصورته آیا خطایی هست در آن؟
در ضمن اگر برنامه باز باشد و کد را حذف و دوباره بنویسیم کار می کند اما وقتی برنامه می بندیم و دوباره بازش می کنیم وقتی دوباره اجراش کنیم اون خطا را میده؟؟

[M_ExceL]

سلام
متاسفانه همون خطا میده
sheet3.Cells(i, "F").Value = Application.WorksheetFunction.Small(sheet4.Range(s heet4.Cells(nn, j), sheet4.Cells(lastrow4, j)), Application.WorksheetFunction.CountIf(sheet4.Range (sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j)), 0) + 1)
کد اصلی به اینصورته آیا خطایی هست در آن؟
در ضمن اگر برنامه باز باشد و کد را حذف و دوباره بنویسیم کار می کند اما وقتی برنامه می بندیم و دوباره بازش می کنیم وقتی دوباره اجراش کنیم اون خطا را میده؟؟

شما یک متغیری به نام i داخل کدتون استفاده کردید که مشخص نیست دلیلش چی هست. آیا کدتون داخل یک حلقه قرار داره؟
اگر کدتون داخل حلقه نیست لزومی نداره به صورت زیر بنویسید :

 Sheet3.Cells(i, "F").Value

متغیر i اشاره داره به ردیف سلول، که اگر مقداری به اون اختصاص ندید کد خطا میده و دلیل خطای کد هم همین موضوع هست.
یا قبلش متغیر i رو مقدار دهی کنید و اون رو مساوی قرار بدید با ردیف مورد نظرتون برای مثال ردیف 5 ستون f :

i=5
Sheet3.Cells(i, "F").Value

و یا اینکه به صورت زیر بنویسید :

Sheet3.Cells(5, "F").Value

متغیر های nn و j و lastrow4 هم باید قبلش مقدار دهی شوند.
اگر کدتون داخل حلقه قرار داره لطفا کد کامل رو قرار بدید و خواستتون رو کامل بیان کنید چک کنیم.

[naser1357]

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

Sub calculate()

Application.ScreenUpdating = False



Dim sheet3 As Worksheet
Set sheet3 = Sheets(3)
Dim sheet1 As Worksheet
Set sheet1 = Sheets(1)
Dim sheet9 As Worksheet
Set sheet9 = Sheets(9)
Dim sheet2 As Worksheet
Set sheet2 = Sheets(2)
Dim sheet4 As Worksheet
Set sheet4 = Sheets(4)
Dim sheet5 As Worksheet
Set sheet5 = Sheets(5)
Dim sheet6 As Worksheet
Set sheet6 = Sheets(6)
Dim sheet7 As Worksheet
Set sheet7 = Sheets(7)

sheet4col = 8
lastrow1 = sheet1.Cells(sheet1.Rows.count, 3).End(xlUp).Row
lastcol1 = sheet1.Cells(10, sheet1.Columns.count).End(xlToLeft).Column
sheet1.Range(sheet1.Cells(4, 1), sheet1.Cells(lastrow1, 1)).Copy
sheet3.Range(sheet3.Cells(4, 1), sheet3.Cells(lastrow1, 1)).PasteSpecial

sheet1.Range(sheet1.Cells(4, sheet4col), sheet1.Cells(lastrow1, sheet4col)).Copy
sheet3.Range(sheet3.Cells(4, sheet4col), sheet3.Cells(lastrow1, "C")).PasteSpecial


lastrow4 = sheet4.Cells(sheet4.Rows.count, 3).End(xlUp).Row
lastcol4 = sheet4.Cells(1, sheet4.Columns.count).End(xlToLeft).Column
lastrow5 = sheet5.Cells(sheet5.Rows.count, 3).End(xlUp).Row
lastcol5 = sheet5.Cells(1, sheet5.Columns.count).End(xlToLeft).Column
lastrow6 = sheet6.Cells(sheet6.Rows.count, 3).End(xlUp).Row
lastcol6 = sheet6.Cells(1, sheet6.Columns.count).End(xlToLeft).Column
lastrow7 = sheet7.Cells(sheet7.Rows.count, 3).End(xlUp).Row
lastcol7 = sheet7.Cells(1, sheet7.Columns.count).End(xlToLeft).Column
lastrow9 = sheet9.Cells(sheet9.Rows.count, 3).End(xlUp).Row
lastcol9 = sheet9.Cells(10, sheet9.Columns.count).End(xlToLeft).Column

n = sheet2.Cells(1, "H").Value
m = sheet2.Cells(2, "H").Value
h = sheet2.Cells(7, "H").Value
hvol = sheet2.Cells(4, "H").Value
nn = Application.WorksheetFunction.Max(2, lastrow4 - n + 1)
mm = Application.WorksheetFunction.Max(2, lastrow4 - m + 1)
hh = Application.WorksheetFunction.Max(2, lastrow5 - h)


For i = 4 To lastrow1
    Dim find As Range
    Dim result As Range
    Set find = sheet4.Range(sheet4.Cells(1, 1), sheet4.Cells(1, lastcol4))
    Set result = find.find(sheet3.Cells(i, 1).Value)
    If result Is Nothing Then
        GoTo nex:
    End If
    j = result.Column
    sheet3.Cells(i, "B").Value = Application.WorksheetFunction.Average(sheet4.Range(sheet4.Cells(2, j), sheet4.Cells(lastrow4, j)))
    sheet3.Cells(i, "D").Value = Application.WorksheetFunction.Max(sheet4.Range(sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j)))
    Set find = sheet4.Range(sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j))
    Set result = find.find(sheet3.Cells(i, "D").Value)
    sheet3.Cells(i, "E").Value = sheet4.Cells(result.Row, 1)
    day3 = result.Row
    
    
     sheet3.Cells(i, "F").Value = Application.WorksheetFunction.Small(sheet4.Range(sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j)), Application.WorksheetFunction.CountIf(sheet4.Range(sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j)), 0) + 1)
     
     
    Set find = sheet4.Range(sheet4.Cells(nn, j), sheet4.Cells(lastrow4, j))
    Set result = find.find(sheet3.Cells(i, "F").Value)
    sheet3.Cells(i, "G").Value = sheet4.Cells(result.Row, 1)
    day1 = result.Row
    If sheet3.Cells(i, "F").Value <> 0 Then
        sheet3.Cells(i, "H").Value = (sheet3.Cells(i, "D").Value - sheet3.Cells(i, "F").Value) / sheet3.Cells(i, "F").Value
    End If
     If sheet3.Cells(i, "L").Value <> 0 Then
        sheet3.Cells(i, "BO").Value = (sheet3.Cells(i, "D").Value - sheet3.Cells(i, "L").Value) / sheet3.Cells(i, "L").Value
    End If
    Dim d1 As Date
    d1 = s2m(sheet3.Cells(i, "E").Value)
    Dim d2 As Date
    d2 = s2m(sheet3.Cells(i, "G").Value)
    sheet3.Cells(i, "I").Value = d2 - d1
    
    sheet3.Cells(i, "J").Value = Application.WorksheetFunction.Max(sheet4.Range(sheet4.Cells(mm, j), sheet4.Cells(lastrow4, j)))
    Set find = sheet4.Range(sheet4.Cells(mm, j), sheet4.Cells(lastrow4, j))
    Set result = find.find(sheet3.Cells(i, "J").Value)
    sheet3.Cells(i, "K").Value = sheet4.Cells(result.Row, 1)
    day4 = result.Row
      
    sheet3.Cells(i, "L").Value = Application.WorksheetFunction.Small(sheet4.Range(sheet4.Cells(mm, j), sheet4.Cells(lastrow4, j)), Application.WorksheetFunction.CountIf(sheet4.Range(sheet4.Cells(mm, j), sheet4.Cells(lastrow4, j)), 0) + 1)
    Set find = sheet4.Range(sheet4.Cells(mm, j), sheet4.Cells(lastrow4, j))
    Set result = find.find(sheet3.Cells(i, "L").Value)
    sheet3.Cells(i, "M").Value = sheet4.Cells(result.Row, 1)
    
    day2 = result.Row
    test = Application.WorksheetFunction.Max(sheet4.Range(sheet4.Cells(day2, j), sheet4.Cells(day1, j)))
    Dim day_o As Long
    If sheet3.Cells(i, "C").Value >= test Then
        
        sheet3.Cells(i, "N").Value = Application.WorksheetFunction.Max(sheet4.Range(sheet4.Cells(2, j), sheet4.Cells(lastrow4, j)))
    Set find = sheet4.Range(sheet4.Cells(2, j), sheet4.Cells(lastrow4, j))
    Set result = find.find(sheet3.Cells(i, "N").Value)
        sheet3.Cells(i, "O").Value = sheet4.Cells(result.Row, 1)
        day_o = result.Row
        day_mm = result.Row
    
    Else
        sheet3.Cells(i, "N").Value = test
        Set find = sheet4.Range(sheet4.Cells(day2, j), sheet4.Cells(day1, j))
        Set result = find.find(sheet3.Cells(i, "N").Value)
        sheet3.Cells(i, "O").Value = sheet4.Cells(result.Row, 1)
        day_o = result.Row
        If result.Row + 1 <= lastrow4 Then
            sheet3.Cells(i, "AG").Value = sheet4.Cells(result.Row + 1, j).Value
       End If

    End If
    
    test = Application.WorksheetFunction.Min(sheet4.Range(sheet4.Cells(day4, j), sheet4.Cells(day3, j)))
    If sheet3.Cells(i, "C").Value <= test Then
   
        sheet3.Cells(i, "P").Value = Application.WorksheetFunction.Small(sheet4.Range(sheet4.Cells(2, j), sheet4.Cells(lastrow4, j)), Application.WorksheetFunction.CountIf(sheet4.Range(sheet4.Cells(2, j), sheet4.Cells(lastrow4, j)), 0) + 1)
    Set find = sheet4.Range(sheet4.Cells(2, j), sheet4.Cells(lastrow4, j))
    Set result = find.find(sheet3.Cells(i, "P").Value)
        sheet3.Cells(i, "Q").Value = sheet4.Cells(result.Row, 1)
        day_qq = result.Row
    
    Else
        sheet3.Cells(i, "P").Value = test
    Set find = sheet4.Range(sheet4.Cells(day3, j), sheet4.Cells(day4, j))
    Set result = find.find(sheet3.Cells(i, "P").Value)
        sheet3.Cells(i, "Q").Value = sheet4.Cells(result.Row, 1)
    
    End If
    oo = Application.WorksheetFunction.Max(day_o - n + 1, 2)
    ooo = Application.WorksheetFunction.Max(day_o - n, 2)
    sheet3.Cells(i, "R").Value = Application.Average(sheet4.Cells(oo, j), sheet4.Cells(day_o, j))
    sheet3.Cells(i, "S").Value = Application.Average(sheet4.Cells(ooo, j), sheet4.Cells(day_o - 1, j))
    

    Set find = sheet5.Range(sheet5.Cells(2, 1), sheet5.Cells(lastrow5, 1))
    Set result = find.find(sheet3.Cells(i, "O").Value)
    day_o = result.Row
    sheet3.Cells(i, "AW").Value = sheet5.Cells(day_o, j).Value
    
    Set find = sheet5.Range(sheet5.Cells(2, 1), sheet5.Cells(lastrow5, 1))
    Set result = find.find(sheet3.Cells(i, "Q").Value)
    day_q = result.Row
    sheet3.Cells(i, "BB").Value = sheet5.Cells(day_q, j).Value
    
    oo = Application.WorksheetFunction.Max(day_o - h, 2)
    ooo = Application.WorksheetFunction.Max(day_o - h + 1, 2)
    qq = Application.WorksheetFunction.Max(day_q - h, 2)
    qqq = Application.WorksheetFunction.Max(day_q - h + 1, 2)
    
    sheet3.Cells(i, "T").Value = Application.Average(sheet5.Cells(oo, j), sheet5.Cells(day_o, j))
    sheet3.Cells(i, "U").Value = Application.Average(sheet5.Cells(ooo, j), sheet5.Cells(day_o - 1, j))
   sheet3.Cells(i, "V").Value = 0
    If day_o > ooo Then
        For num = ooo + 1 To day_o
            If sheet5.Cells(num, j).Value > sheet5.Cells(num - 1, j).Value Then
                sheet3.Cells(i, "V").Value = sheet3.Cells(i, "V").Value + 1
            End If
        Next num

    End If

    sheet3.Cells(i, "W").Value = 0
    If day_q > qqq Then
        For num = qqq + 1 To day_q
            If sheet5.Cells(num, j).Value > sheet5.Cells(num - 1, j).Value Then
                sheet3.Cells(i, "W").Value = sheet3.Cells(i, "W").Value + 1
            End If
        Next num

    End If

    Set find = sheet6.Range(sheet6.Cells(2, 1), sheet6.Cells(lastrow6, 1))
    Set result = find.find(sheet3.Cells(i, "O").Value)
    day_o = result.Row
    oo = Application.WorksheetFunction.Max(day_o - h + 1, 2)
   sheet3.Cells(i, "X").Value = 0
   sheet3.Cells(i, "Y").Value = 0
    If day_o > oo Then
        For num = oo + 1 To day_o
            If sheet6.Cells(num, j).Value > sheet6.Cells(num - 1, j).Value Then
                sheet3.Cells(i, "X").Value = sheet3.Cells(i, "X").Value + 1
            Else
                sheet3.Cells(i, "Y").Value = sheet3.Cells(i, "Y").Value + 1

            End If
        Next num

    End If
    Set find = sheet7.Range(sheet7.Cells(2, 1), sheet7.Cells(lastrow7, 1))
    Set result = find.find(sheet3.Cells(i, "O").Value)
    day_o = result.Row
    Set result = find.find(sheet3.Cells(i, "Q").Value)
    day_q = result.Row
    qq = Application.WorksheetFunction.Max(day_q - h + 1, 2)
    oo = Application.WorksheetFunction.Max(day_o - h + 1, 2)
    sheet3.Cells(i, "Z").Value = Application.WorksheetFunction.sum(sheet7.Cells(oo, j), sheet7.Cells(day_o, j))
    sheet3.Cells(i, "AA").Value = Application.WorksheetFunction.sum(sheet7.Cells(qq, j), sheet7.Cells(day_q, j))
    
    sheet3.Cells(i, "AB").Value = 0
    sheet3.Cells(i, "AC").Value = 0
    If lastrow4 > nn Then
        For num = nn + 1 To lastrow4
            If sheet4.Cells(num, j).Value > sheet4.Cells(num - 1, j).Value Then
                sheet3.Cells(i, "AB").Value = sheet3.Cells(i, "AB").Value + 1
            Else
                sheet3.Cells(i, "AC").Value = sheet3.Cells(i, "AC").Value + 1

            End If
        Next num

    End If
    
    d1 = s2m(sheet3.Cells(i, "E").Value)
    d2 = s2m(sheet3.Cells(i, "M").Value)
    d3 = s2m(sheet3.Cells(i, "G").Value)
    d4 = s2m(sheet3.Cells(i, "K").Value)
    sheet3.Cells(i, "AD").Value = ""
    If d1 > d2 And sheet3.Cells(i, "H").Value >= 0.07 And sheet3.Cells(i, "AB").Value > sheet3.Cells(i, "AC").Value And sheet3.Cells(i, "BO").Value >= 0.2 Then
        sheet3.Cells(i, "AD").Value = "ASENDING"
        
    End If
    If d3 > d4 And sheet3.Cells(i, "H").Value < 0.07 And sheet3.Cells(i, "AB").Value < sheet3.Cells(i, "AC").Value And sheet3.Cells(i, "BO").Value < 0.2 Then
        sheet3.Cells(i, "AD").Value = "DESENDING"
    End If
     If d1 > d2 And sheet3.Cells(i, "H").Value >= 0.07 And sheet3.Cells(i, "AB").Value > sheet3.Cells(i, "AC").Value Then
        sheet3.Cells(i, "BP").Value = "ASENDING"
        
    End If
    If d1 < d2 And sheet3.Cells(i, "H").Value < 0.07 And sheet3.Cells(i, "AB").Value < sheet3.Cells(i, "AC").Value Then
        sheet3.Cells(i, "BP").Value = "DESENDING"
     End If
    sheet3.Cells(i, "AE").Value = Application.Average(sheet4.Cells(nn - 1, j), sheet4.Cells(lastrow4 - 1, j))
    sheet3.Cells(i, "AF").Value = Application.Average(sheet4.Cells(mm - 1, j), sheet4.Cells(lastrow4 - 1, j))
    If day1 + 1 <= lastrow4 Then
        sheet3.Cells(i, "AH").Value = sheet4.Cells(day1 + 1, j).Value
    End If
    If sheet3.Cells(i, "N").Value <> "0" And IsNumeric(sheet3.Cells(i, "N").Value) And IsNumeric(sheet3.Cells(i, "R").Value) Then
        sheet3.Cells(i, "AI").Value = 100 * (sheet3.Cells(i, "R").Value - sheet3.Cells(i, "N").Value) / sheet3.Cells(i, "N").Value
    End If
    
    If sheet3.Cells(i, "P").Value <> "0" And IsNumeric(sheet3.Cells(i, "S").Value) And IsNumeric(sheet3.Cells(i, "P").Value) Then
        sheet3.Cells(i, "AJ").Value = 100 * (sheet3.Cells(i, "S").Value - sheet3.Cells(i, "P").Value) / sheet3.Cells(i, "P").Value
    End If


    If sheet3.Cells(i, "C").Value <> 0 And IsNumeric(sheet3.Cells(i, "AE").Value) And IsNumeric(sheet3.Cells(i, "C").Value) Then
        sheet3.Cells(i, "AK").Value = 100 * (sheet3.Cells(i, "AE").Value - sheet3.Cells(i, "C").Value) / sheet3.Cells(i, "C").Value
    End If

    If IsNumeric(sheet3.Cells(i, "AF").Value) And IsNumeric(sheet3.Cells(i, "AE").Value) Then
        If sheet3.Cells(i, "AE").Value <> 0 Then
            sheet3.Cells(i, "AL").Value = 100 * (sheet3.Cells(i, "AF").Value - sheet3.Cells(i, "AE").Value) / sheet3.Cells(i, "AE").Value
        End If
    End If

    oo = Application.WorksheetFunction.Max(day_mm - m + 1, 2)
    If lastrow4 > oo Then
       count = 0
       sum = 0
        For num = oo + 1 To day_mm
            If sheet4.Cells(num, j).Value > sheet4.Cells(num - 1, j).Value Then
                sum = sum + sheet4.Cells(num, j).Value
                count = count + 1
            
            End If
        Next num
        If count > 0 Then
            sheet3.Cells(i, "AM").Value = sum / count
        End If
    End If
    If IsNumeric(sheet3.Cells(i, "AM").Value) And IsNumeric(sheet3.Cells(i, "R").Value) Then
        If sheet3.Cells(i, "R").Value <> 0 Then
            sheet3.Cells(i, "AN").Value = 100 * (sheet3.Cells(i, "AM").Value - sheet3.Cells(i, "R").Value) / sheet3.Cells(i, "R").Value
        End If
    End If

    oo = Application.WorksheetFunction.Max(lastrow4 - m, 2)
    If lastrow4 > oo Then
       count = 0
       sum = 0
        For num = oo + 1 To lastrow4
            If sheet4.Cells(num, j).Value > sheet4.Cells(num - 1, j).Value Then
                sum = sum + sheet4.Cells(num, j).Value
                count = count + 1
            
            End If
        Next num
        If count > 0 Then
            sheet3.Cells(i, "AO").Value = sum / count
        End If
    End If


    If IsNumeric(sheet3.Cells(i, "AE").Value) And IsNumeric(sheet3.Cells(i, "AO").Value) Then
        If sheet3.Cells(i, "AE").Value <> 0 Then
            sheet3.Cells(i, "AP").Value = 100 * (sheet3.Cells(i, "AO").Value - sheet3.Cells(i, "AE").Value) / sheet3.Cells(i, "AE").Value
        End If
    End If


    oo = Application.WorksheetFunction.Max(day_qq - m + 1, 2)
    If lastrow4 > oo Then
       count = 0
       sum = 0
        For num = oo + 1 To day_qq
            If sheet4.Cells(num, j).Value < sheet4.Cells(num - 1, j).Value Then
                sum = sum + sheet4.Cells(num, j).Value
                count = count + 1
            
            End If
        Next num
        If count > 0 Then
            sheet3.Cells(i, "AQ").Value = sum / count
        End If
    End If


    If IsNumeric(sheet3.Cells(i, "F").Value) And IsNumeric(sheet3.Cells(i, "AE").Value) Then
        If sheet3.Cells(i, "F").Value <> 0 Then
            sheet3.Cells(i, "AR").Value = 100 * (sheet3.Cells(i, "AE").Value - sheet3.Cells(i, "F").Value) / sheet3.Cells(i, "F").Value
        End If
    End If

    If IsNumeric(sheet3.Cells(i, "AE").Value) And IsNumeric(sheet3.Cells(i, "D").Value) Then
        If sheet3.Cells(i, "AE").Value <> 0 Then
            sheet3.Cells(i, "AS").Value = 100 * (sheet3.Cells(i, "D").Value - sheet3.Cells(i, "AE").Value) / sheet3.Cells(i, "AE").Value
        End If
    End If

    If IsNumeric(sheet3.Cells(i, "AH").Value) And IsNumeric(sheet3.Cells(i, "S").Value) Then
        If sheet3.Cells(i, "AH").Value <> 0 Then
            sheet3.Cells(i, "AT").Value = 100 * (sheet3.Cells(i, "S").Value - sheet3.Cells(i, "AH").Value) / sheet3.Cells(i, "AH").Value
        End If
    End If
    ddd = Date
    If s2m(sheet4.Cells(lastrow4, 1).Value) = ddd Then
        sheet3.Cells(i, "AU").Value = sheet4.Cells(lastrow4 - 1, j).Value
    Else
        sheet3.Cells(i, "AU").Value = sheet4.Cells(lastrow4, j).Value
    End If

    If IsNumeric(sheet3.Cells(i, "AU").Value) And IsNumeric(sheet3.Cells(i, "C").Value) Then
        If sheet3.Cells(i, "C").Value <> 0 Then
            sheet3.Cells(i, "AV").Value = 100 * (sheet3.Cells(i, "AU").Value - sheet3.Cells(i, "C").Value) / sheet3.Cells(i, "C").Value
        End If
    End If

    If IsNumeric(sheet3.Cells(i, "AW").Value) And IsNumeric(sheet3.Cells(i, "T").Value) Then
        If sheet3.Cells(i, "AW").Value <> 0 Then
            sheet3.Cells(i, "AX").Value = 100 * (sheet3.Cells(i, "T").Value - sheet3.Cells(i, "AW").Value) / sheet3.Cells(i, "AW").Value
        End If
    End If

    If s2m(sheet5.Cells(lastrow4, 1).Value) = ddd Then
        sheet3.Cells(i, "AY").Value = sheet5.Cells(lastrow4 - 1, j).Value
    Else
        sheet3.Cells(i, "AY").Value = sheet5.Cells(lastrow4, j).Value
    End If

    sheet3.Cells(i, "AZ").Value = Application.Average(sheet5.Cells(hh, j), sheet5.Cells(lastrow5 - 1, j))
 sheet3.Cells(i, "AZ").Value = sheet3.Cells(i, "U").Value


    If IsNumeric(sheet3.Cells(i, "AY").Value) And IsNumeric(sheet3.Cells(i, "AZ").Value) Then
        If sheet3.Cells(i, "AZ").Value <> 0 Then
            sheet3.Cells(i, "BA").Value = 100 * (sheet3.Cells(i, "AY").Value - sheet3.Cells(i, "AZ").Value) / sheet3.Cells(i, "AZ").Value
        End If
    End If

    If IsNumeric(sheet3.Cells(i, "BB").Value) And IsNumeric(sheet3.Cells(i, "U").Value) Then
        If sheet3.Cells(i, "BB").Value <> 0 Then
            sheet3.Cells(i, "BC").Value = 100 * (sheet3.Cells(i, "U").Value - sheet3.Cells(i, "BB").Value) / sheet3.Cells(i, "BB").Value
        End If
    End If

    sheet3.Cells(i, "BD").Value = 0
   sss = Application.WorksheetFunction.Max(lastrow5 - hvol - 1, 2)
    If lastrow5 - 2 > sss Then
        For num = sss + 1 To lastrow5 - 2
            If sheet5.Cells(num, j).Value > sheet5.Cells(num - 1, j).Value Then
                sheet3.Cells(i, "BD").Value = sheet3.Cells(i, "BD").Value + 1
            End If
        Next num

    End If

    sheet3.Cells(i, "BE").Value = 0
    sheet3.Cells(i, "BF").Value = 0
   sss = Application.WorksheetFunction.Max(lastrow6 - hvol, 2)
    If lastrow5 - 1 > sss Then
        For num = sss + 1 To lastrow6 - 2
            If sheet6.Cells(num, j).Value > sheet6.Cells(num - 1, j).Value Then
                sheet3.Cells(i, "BE").Value = sheet3.Cells(i, "BE").Value + 1
            Else
                sheet3.Cells(i, "BF").Value = sheet3.Cells(i, "BF").Value + 1
            End If
        Next num
    End If

    hh = Application.WorksheetFunction.Max(2, lastrow7 - hvol)
    sheet3.Cells(i, "BG").Value = Application.sum(sheet7.Cells(hh, j), sheet7.Cells(lastrow7 - 1, j))

    If IsNumeric(sheet3.Cells(i, "AG").Value) And IsNumeric(sheet3.Cells(i, "R").Value) Then
        If sheet3.Cells(i, "AG").Value <> 0 Then
            sheet3.Cells(i, "BH").Value = 100 * (sheet3.Cells(i, "R").Value - sheet3.Cells(i, "AG").Value) / sheet3.Cells(i, "AG").Value
        End If
    End If

    If IsNumeric(sheet3.Cells(i, "AG").Value) And IsNumeric(sheet3.Cells(i, "S").Value) Then
        If sheet3.Cells(i, "S").Value <> 0 Then
            sheet3.Cells(i, "BI").Value = 100 * (sheet3.Cells(i, "AG").Value - sheet3.Cells(i, "S").Value) / sheet3.Cells(i, "S").Value
        End If
    End If






    
    count = 0
    sum = 0
    For num = mm To lastrow4 - 1
        If sheet4.Cells(num, j).Value < sheet4.Cells(num - 1, j).Value Then
            sum = sum + sheet4.Cells(num, j).Value
            count = count + 1
           
            End If
    Next num
    If count > 0 Then
        sheet3.Cells(i, "BJ").Value = sum / count
    End If

    If IsNumeric(sheet3.Cells(i, "AE").Value) And IsNumeric(sheet3.Cells(i, "BI").Value) Then
        If sheet3.Cells(i, "AE").Value <> 0 Then
            sheet3.Cells(i, "BK").Value = 100 * (sheet3.Cells(i, "BI").Value - sheet3.Cells(i, "AE").Value) / sheet3.Cells(i, "AE").Value
        End If
    End If





    For b = 7 To lastrow9
        temp1 = sheet3.Cells(i, 1).Value
        temp2 = Split(sheet9.Cells(b, 1).Value, ",")(1)

        temp1 = Replace(temp1, IsNumber, "")
        If temp1 = temp2 Then
            sheet3.Cells(i, "BN") = sheet9.Cells(b, 3)
        End If
        Next b

filter (i)





nex:

Next i





Application.ScreenUpdating = False





End Sub

[M_ExceL]

من اروری دریافت نمیکنم و کدتون داره اجرا میشه ولی یک فانکشن استفاده کردید به نام s2m و مشخص نیست کارش چی هست آیا فانکشن s2m رو قبلا ایجاد کردید؟
همچنین این خط کدتون هم دارای خطا هست :

Filter (i)

با برداشتن فانکشن s2m و خط فوق کد بدون خطا اجرا میشه.
حالا این که این کد شما دقیقا چه عملیاتی داره انجام میده خودتون بهتر می دونید.

[naser1357]

ممکنه اصلاح شده اش بفرستین؟