[حل شده] تغییر عددsumif ,countif و درج فرمول با استفاده از vba

[habib100]

با سلا م و خسته نباشید
فایل اکسلی را به همراه توضیحات ضمیمه کرده ام، خواهشمندم راهنمایی بفرمائید.
باتشکر

[Amir Ghasemiyan]

سلام دوست عزيز
چرا اصرار داريد حتما با vb حل بشه؟
خود اكسل راه حل هاي ساده اي داره نيازي به كدنويسي نيست

[habib100]

سلام
بله درست می فرمایید ، هر چند ماکرو باعث سنگینی فایل می شود ولی جهت جلوگیری از پاک شدن تصادفی داده ها توسط کاربر وارتباطی که شیتها با هم دارند که باعث می شود خروجی ها اشتباه شوند، و سئوال دوم با راه حل های ساده اکسل قابل انجام نبود و دانستن این موارد با ماکرو برایم جالب می باشد.

ممنونم از همکاری شما

[habib100]

با سلام
ممکن هست دوستان راهنمایی کنن؟

[M_ExceL]

با سلا م و خسته نباشید
فایل اکسلی را به همراه توضیحات ضمیمه کرده ام، خواهشمندم راهنمایی بفرمائید.
باتشکر

سلام،
برای شیت اول کد زیر :

Private Sub Worksheet_Change(ByVal Target As Range)
lr1 = Cells(Rows.Count, 4).End(3).Row
lr2 = Cells(Rows.Count, 5).End(3).Row
If lr1 > lr2 Then
lrow = lr1
Else
lrow = lr2
End If
If WorksheetFunction.CountA(Range("d" & lrow & ":e" & lrow)) > 1 Then
Range("f" & lrow) = "=d" & lrow & "*e" & lrow
End If
End Sub

برای شیت دوم کد زیر رو استفاده کنید :

Sub sm_cntf()
Dim rr() As Variant
Dim rr2() As Variant
lr = Cells(Rows.Count, 1).End(3).Row
Dim cel, rng As Range
Set rng = Range("a5:a" & lr).SpecialCells(xlCellTypeVisible)
rd = WorksheetFunction.CountA(rng)
ReDim Preserve rr(1 To rd)
ReDim Preserve rr2(1 To rd)
i = 1
j = 1
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
            For Each cel In rng
                If cel = Range("a2") Then
                    rr(i) = cel.Offset(, 1)
                    i = i + 1
                End If
                If cel = Range("a3") Then
                    rr2(j) = cel.Offset(, 1)
                    j = j + 1
                End If
            Next
        .ScreenUpdating = True
        .EnableEvents = True
    End With
Range("d2") = WorksheetFunction.Sum(rr)
Range("d3") = WorksheetFunction.Sum(rr2)
Range("g2") = i - 1
Range("g3") = j - 1
End Sub

یا حق.

[habib100]

سلام
ممنون برای شیت 1 کار نمی کند؟

[M_ExceL]

سلام
ممنون برای شیت 1 کار نمی کند؟

کار میکنه،
البته درصورتی که ستون های e و d خالی نباشند، می تونید شرط رو تغییر بدید.

[habib100]

سلام
موقعی که در ستون e عدد می زنم ، error عکس پیوست را می دهد . و محاسبه را درست ثبت می کند این ارور مربوط به چیه؟[ATTACH=CONFIG]19499[/ATTACH]

[M_ExceL]

سلام
موقعی که در ستون e عدد می زنم ، error عکس پیوست را می دهد . و محاسبه را درست ثبت می کند این ارور مربوط به چیه؟[ATTACH=CONFIG]19499[/ATTACH]

کد زیر رو جایگزین کنید :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
lr1 = Cells(Rows.Count, 4).End(3).Row
lr2 = Cells(Rows.Count, 5).End(3).Row
If lr1 > lr2 Then
lrow = lr1
Else
lrow = lr2
End If
If WorksheetFunction.CountA(Range("d" & lrow & ":e" & lrow)) > 1 Then
Range("f" & lrow) = "=d" & lrow & "*e" & lrow
End If
Application.EnableEvents = True
End Sub

[habib100]

ممنون درست شد.