- Katılım
- 5 Ocak 2014
- Mesajlar
- 3,333
- Tepkime puanı
- 6
- Puanları
- 136
OKEK bulan Excel makro kodunu işlediğimiz bu dersin işinize yarayacağını düşünüyoruz.
Kod:
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, degerDim 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 Booleanbul = 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 = makilk:--- 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 uzunlukdizi(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 makyön = FalseFor y = 1 To uzunlukIf dizi(y) Mod v = 0 Thenyön = Truedizi(y) = dizi(y) / vEnd IfNextIf yön = True Thenbul = bul * vFor 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ırarakveya 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 = " & bulEnd Sub
Not: Bu döküman kendi çalışmalarımın sonucu olarak hazırlanan notlardan oluşmuştur.
Kod:
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, degerDim 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 Booleanbul = 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 = makilk:--- 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 uzunlukdizi(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 makyön = FalseFor y = 1 To uzunlukIf dizi(y) Mod v = 0 Thenyön = Truedizi(y) = dizi(y) / vEnd IfNextIf yön = True Thenbul = bul * vFor 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ırarakveya 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 = " & bulEnd SubNot: Bu döküman kendi çalışmalarımın sonucu olarak hazırlanan notlardan oluşmuştur.
