Bunu praktiki misal üzərində nəzərdən keçirək. Aşağıdakı cədvəldə bizim 6 səhifəlik bir excel kitabımız var. "Sum" adlı birinci səhifəmizdə kriteriyaları görürsüz ("B9:B18"). "Səhifə1-Səhifə5"-ə kimi səhifələrin hər biri eyni quruluşdadır və kriteriyalar B6-dan başlayaraq aşağı doğru düzülərək məbləğləri də qarşılarında yazılıb. Tapmalı olduğumuz məsələ isə bu "Sum" adlı səhifədəki kriteriyaların hər biri üzrə cəmi məbləgin tapılmasıdır. Bu əgər bir səhifə üçün olsa idi onda biz Sumif() funksiyasından istifadə edərdik. Amma göründüyü kimi bizim səhifələrimizin sayı çoxdur. Belə halda bizim bu bezdirici işimizi avtomatlaşdırmağımız lazım gələcək. Çünki bunları formulla etək əlverişsiz və xeyli xavt itkisi deməkdir vaxt isə əlavə puldur. Ona görə də əgər bu kimi məsələlərlə üzləşmisinizsə onda bunu aşağıda izahlı şəkildə yazdığım VBA dan istifadə etməklə həll edə bilərsiniz.
Sub Her_Sehif_Krit_Topla() Application.ScreenUpdating = False Sum = 0 lrow = Sheets("Sum").Cells(Rows.Count, "B").End(xlUp).Row 'Sum adli sehifede "B" sutununda sonuncu setir movqeyini tapiriq Sheets("Sum").Range("C9").Resize(lrow - 9).ClearContents 'C9 ve ondan ashagi olan reqemleri legv edirik (C19-daki cemi saxlamaq shertile) For c = 9 To lrow 'Sherti olaraq burada kriter-lar 9-cu setirden bashlayir sum adli sehifede For sh = 2 To Worksheets.Count 'Axtarish 2-ci sehifeden bashlayaraq excel kitabindaki sonuncu sehifedek davam edecek (Worksheets.Count- excel kitabindaki sehifelerin sayini tapacaq) i = 6 'Sherti olaraq burada 6-ci setirden bashlayir Do While Sheets(sh).Cells(i, 2) <> "" 'her bir axtarish aparilan sehifede 6-ci setirden bashlayaraq bosh xanayadek axtarish edirik If Sheets(sh).Cells(i, 2) = Sheets("Sum").Cells(c, 2) Then 'Eger axtarish edilen kriteriya tapilirsa onda Sum = Sum + Sheets(sh).Cells(i, 3) 'Tapilan mebleg cemlenir Sheets("Sum").Cells(c, 3) = Sum 'Cemlenen mebleg Sum adli sehifeye daxil edilir "C" sutununa End If i = i + 1 'Novbeti setirlere kechmek uchun "i"-nin artimini veririk Loop 'Tsikli yeniden icra edir (ta ki boshluga qeder) Next sh 'Novbeti sehife Sum = 0 'Yaddashi reqemlerden azad edirik ki, diger kriteriyalari cemleyek Next c 'Novbeti kriteriyaya kechid Application.ScreenUpdating = Ture End Sub
