Okek bulan Excel makro kodu

OKEK bulan Excel makro kodunu işlediğimiz bu dersin işinize yarayacağını düşünüyoruz.

OKEK bulan Excel makro kodunu işlediğimiz bu dersin işinize yarayacağını düşünüyoruz.


Sub Okek()

----Örneğin Okek'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, mak, mak1, say, bul, deger

Dim dizi()



---- dizi() adlı dizi değişkeni tanımladık,şimdilik dizi boyutunu boş bıraktık , dizi boyutunu a sütunundaki dolu hücre sayısını öğrenince redim komutuyla belirleyeceğiz---



Dim yön As Boolean

bul = 1



--- 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



--- Dizi() adlı dizi değişkeninin boyutunu A sütunundaki rakam adedi kadar yapıyoruz.---



ReDim dizi(uzunluk)



--- A sütunundaki en büyük rakamı buluyoruz. Okek bulmak için bize lazım olacak---



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

mak1 = mak

ilk:



--- Aşağıda, önce kendimiz ilk 1. yöntemimizi uygulayıp yukarıda bulduğumuz bu mak değerini mak1 değişkenine atıyoruz. Ve A sütunundaki tüm değerler, mak1 değişkenine bölüyoruz. Hepsi kalansız bölünebiliyorsa okek değerini bulmuş olduk. (Okek=mak1). Eğer tek bir tanesi bile mak1 değerine tam kalansız bölünemiyorsa hemen döngüden çıkıp mak1 değerine yukarıdaki mak değerini ekleyip (yani mak1=mak1+mak) işlemi tekrar yapıyoruz. Yani yeni mak1 değerini a sütunundaki tüm değerlere bölüyoruz. Hepsi kalansız bölünüyorsa okek yeni mak1 değeridir. Bölünmeyen değer varsa yine döngüden çıkıyoruz ve mak1 değerine mak değerini ekleyip döngüye girip işlemi tekrar yapıyoruz. 751 kere döngüye girilip okek değeri bulunamazsa  ( yani 751 dafa mak1=mak1+mak yapıldığı halde hala okek değerine ulaşılamadı ise) okek bulmak için (ileri:) alanına atlayıp  2. yönteme geçiyoruz.---



For i = 1 To uzunluk

    If mak1 Mod Cells(i, 1) > 0 Then

        mak1 = mak1 + mak

        say = say + 1

        If say > 751 Then

            GoTo ileri

        End If

        DoEvents

        GoTo ilk

        End If

        

Next

----okek bulmak için kullandığımız 2. yöntem buradan başlıyor---



ileri:

A sütunundaki değerler dizi() değişkenine alınıyor, (üzerlerinde daha rahat işlem yapabilmek için)---



For x = 1 To uzunluk

dizi(x) = Cells(x, 1)

Next



---aşağıda matematikte kullanılan birden fazla sayının okek'ini alma işlemi bilgisayara kodlarla yaptırılıyor, tüm rakamlar 2'ye bölünüyor, tekrar 2'ye bölünebilen varsa 2'ye bölünüyor. Sonra 3'e bölünüyor, 4'e bölünüyor, vb.. Taki listedeki tüm rakamlar bölüne bölüne asal sayı olana kadar. Sonra tüm bölen rakamlar birbiri ile çarpılarak okek bulunuyor. Aynen matematikte birden fazla sayının okekini alma işlemi yani---



For v = 2 To mak

yön = False

For y = 1 To uzunluk

If dizi(y) Mod v = 0 Then

yön = True

dizi(y) = dizi(y) / v

End If

Next

If yön = True Then

bul = bul * v

For i = 1 To uzunluk

    For j = 1 To uzunluk



        If dizi(i) > dizi(j) Then

        deger = dizi(i)

        dizi(i) = dizi(j)

        dizi(j) = deger

        End If

        Next

        Next

        mak = dizi(1)

    v = 1

    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) = "Okek ="

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

    Cells(1, 3) = bul

     MsgBox "OKEK = " & bul

End Sub



Not: Bu döküman kendi çalışmalarımın sonucu olarak hazırlanan notlardan oluşmuştur.
  • Etiketler;
Yorum Yaz

Yorum yazabilmek için üye girişi yapmanız gerekiyor!

sıfırdan excell makro ögrenmek isterim mümkünmü
ödevim var yardımcı olurmusunuz burda anlatılanlardanda bişey anlamadım:agla::gul:

Yukarı Git