Skip to main content

AccessTr.neT


obeb

Çözüldü #1
Kod:
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


bunu bir Excel dosyasına ekleyip örnek haline getirebilirmisiniz
ben yapamadım
teşekkürler
@benbendedeilem
Cevapla
Çözüldü #2
Kod:
Sub GCDx()

Dim Max             As Integer
Dim x               As Integer
Dim GCD             As Integer
Dim GCDTemp         As Integer
Dim Cell            As Object
Dim Rng             As String

    Rng = "A1:D1"
    Max = Application.WorksheetFunction.Max(Range(Rng))
    For x = 1 To Int(Max / 2) + 1
        For Each Cell In Range(Rng)
            If Cell.Value Mod x = 0 Then
                GCDTemp = x
                Else
                GCDTemp = 0
                Exit For
            End If
        Next
        GCD = Application.WorksheetFunction.Max(GCD, GCDTemp)
    Next
    MsgBox (GCD)

End Sub

@benbendedeilem
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task