Sub obeb()


---- Örneğin OBEB'ini  bulacağımız sayıları Excel hücrelerimizde A sütununda alt alta yazalım. Arada  boş bırakılan hücre olmasın.  A sütununda yazdığımız rakamlardan başka  bir şey yazılı olmasın. ---


---- Değişkenleri tanımlayalım. ---





Dim uzunluk, min


Dim yön As Boolean


---- A sütununda 65000'inci satıra kadar olan hücrelerden   yukarıdan aşağıya inildiğinde en aşağıdaki son dolu hücrenin  kaçıncı satırda olduğunu bulalım. ---





uzunluk = [a65000].End(3).Row





---- Eğer rakamların yazılacağı A sütununda 2'den az sayıda hücrede rakam varsa OBEB veya OKEK hesaplamaya gerek kalmaz. Durum öyle ise "exit sub" yap, yani bu programcığı burada kapat, çalışmasını durdur yani. --- 





If uzunluk < 2 Then Exit Sub





---- A sütunundaki rakamlardan en küçüğünü min değişkenine ata, çünkü OBEB hesabında en küçük değer bize lazım olacak---





min = WorksheetFunction.min(Range("A1:A" & uzunluk))





---- Döngüye gir.  i değişkenini  min değerinden 1'e kadar birer birer azalt.---





For i = min To 1 Step -1


    yön = False


    For j = 1 To uzunluk


        DoEvents





---- a sütunundaki rakamların hepsini i değerine böl. Eğer kalansız bölünüyorsa i değeri obeb değeridir.---





If Cells(j, 1) Mod i  0 Then





---- a sütunundaki rakamlardan tek bir tanesi bile i değerine tam bölünemiyorsa döngüden çık





i değerini bir azalt, tekrar a sütunundaki tüm değerleri yeni i değerine böl. hepsi kalansız bölünüyorsa obeb yeni i değeridir. Aralarında tam bölünemeyen varsa yine döngüden çık. 





i değerini yine 1 azalt. Tekrar a sütunundaki tüm değerleri yeni i değerine böl. a sütunundaki  tüm sayıların kalansız bölüneceği i değerine ulaşıncaya kadar işlem böyle devam etsin. 





i değeri 1 rakamına ininceye kadar a sütunundaki değerleri kalansız bölen i rakamına ulaşmaya çalış. Bulunamazsa en sonunda i=1 eşit olur ve 1 rakamına tüm değerler kalansız bölüneceği için obeb 1 olur.---





            yön = True


            Exit For


        End If


    Next





---- a sütunundaki tüm değerlerin  i rakamına tam bölündüğünde yön=false olur ve  döngüden tamamen çıkılır, çünkü aranan şartlara uyan değer artık elde edilmiştir.---





If yön = False Then


    Exit For


End If


Next





---- şimdi emeğimizin karşılığını alma zamanı, bulduğumuz sonuçları hücrelere yazdırarak veya msgbox ile bildirerek, gereken yerlerde kullanırız.---


 


Range("A1:A" & uzunluk).Select


 Cells(1, 2) = "Obeb ="


 Cells(1, 2).Font.Bold = True


 Cells(1, 3) = i


MsgBox "OBEB = " & i


End Sub