Soru Artık İşin İçinden Çıkamıyorum:-(

[halit3]

Formdaki 58 nolu mesajdakinin dışındaki dosyaları siliyorum onlar bir işe yaramaz.

 

[yesimgurol]

Halit bey , merhabalar,

Öğrenmek ve kodları anlamak adına bir olasılık için kod eklemek istedim. (aktar1 kodlarına) Sonuç alamadım

Eklemek istediğim kod;

If Cells(i, cocuk1).Value <> Cells(i, baba1) And Cells(i, cocuk1).Value = Cells(i, baba2) Then
If Cells(i, cocuk2).Value = Cells(i, baba1) And Cells(i, cocuk2).Value = Cells(i, baba2) Then
If Cells(i, cocuk1).Value = Cells(i, anne1) And Cells(i, cocuk1).Value <> Cells(i, anne2) Then
If Cells(i, cocuk2).Value <> Cells(i, anne1) And Cells(i, cocuk2).Value <> Cells(i, anne2) Then
'MsgBox aranan2 & Chr(10) & i
Cells(i, sut3).Value = aranan2
If veri = 1 Then
MsgBox 48
End If
End If
End If
End If
End If

Sizin yazdıklarınız arasında yoktu kontrol de ettim. Nerede hata yaptım onu bulmaya çalışıyordum.

 

[yesimgurol]

Tamamdır Halit bey, yanlış yazmışım bir karakteri, dikkatli bakınca fark ettim. Şİmdi oldu.

 

[halit3]

Merhaba
Kodları karşılaştırmak için hata mesajı ekledim ve bazı tutarsızlıklar tesbit ettim
hatalı olan sayfalardaki mavi satırları deneme8 sayfasına topladım.
ayrıca P sutününda kahverengi rengi ile işaretlediğim sayfalar ile deneme8 sayfasındaki kahverengi bölümlerini kontrol et istenen sonuçlar bazısında doğru bazısında yanlış çıkıyor.

İyi olan şu hali hazır verilerde mükerrer kodlama yok

 

[yesimgurol]

Harikasınız Halit bey, ilginize çok ama çok teşekkür ederim. Doğrusu benden daha çok dikkatlisiniz.

 

[yesimgurol]

Merhabalar, yine yazmak zorunda kaldım:-giggle:

Halit bey yok sanırım, kaç gündür takip ediyorum. O yüzden merak ettiğim bir konu oldu. Halit bey çok güzel bir kodlama ile oldukça güzel sonuçlara ulaştırdı sağ olsun beni. Lakin yazmış olduğu kodlara yeni çıkan olasılıkları kendim ekleyebiliyorum çıktıkça buraya kadar sorun yoktu. Ama bugünde bir kaç ekleme yaptım ve kod sanırım artık ekleme yapma dedi:-( Uyarı aldım.

Sub aktar1()
cocuk1 = 6
cocuk2 = 7
sut3 = 21

anne1 = "b"
anne2 = "c"
baba1 = "d"
baba2 = "e"


Range(Cells(3, sut3), Cells(36, sut3)).ClearContents

veri = 0
For i = 3 To Cells(Rows.Count, cocuk1).End(3).Row
aranan1 = Cells(i, cocuk1).Value
aranan2 = Cells(i, cocuk2).Value


If Cells(i, cocuk1).Value = Cells(i, baba1) And Cells(i, cocuk1).Value <> Cells(i, baba2) Then
If Cells(i, cocuk2).Value <> Cells(i, baba1) And Cells(i, cocuk2).Value <> Cells(i, baba2) Then
If Cells(i, cocuk1).Value <> Cells(i, anne1) And Cells(i, cocuk1).Value <> Cells(i, anne2) Then
If Cells(i, cocuk2).Value <> Cells(i, anne1) And Cells(i, cocuk2).Value = Cells(i, anne2) Then
Cells(i, sut3).Value = aranan1
If veri = 1 Then
MsgBox 1
End If

End If
End If
End If
End If

Kodların başı bu şekilde ve ben "MsgBox 1" bu kod blokunu 71' e kadar çıkardım. Uyarı alınca ekleme yapmış olduğum kod bloklarını tek tek silerek en son 64'e kadar indim ve o zaman çalıştı kodlar.

Bu kod blokunu 64'ten daha fazla çoğaltamazmıyım:-(

 

[Haluk]

Kodun genetiğini bozmuş olmanız ihtamali yüksek görünüyor ....

.

 

[yesimgurol]

Kodun genetiğini bozmuş olmanız ihtamali yüksek görünüyor ....

Sanırım

 

[yesimgurol]

Ya Haluk bey, farkındayım bu konu üzerine çok mesaj yazar oldum Daha fazlasını yazamam mı ki sizce..

 

[yesimgurol]

Bu arada şu şeklide bir uyarı almıştım.
"compile error" procedure too large

 

[Haluk]

Bu arada şu şeklide bir uyarı almıştım.
"compile error" procedure too large

Bahsettiğim genetik bozulması oydu zaten ......

Çok fazla satır kod olmuş, VBA isyan etmiş.

.

 

[yesimgurol]

Çok fazla satır kod olmuş, VBA isyan etmiş.

Hmmm, e o da haklı elbette..

 

[Haluk]

Bir yolu mutlaka bulunur ama ben olayın sadece "geyik" kısmına katıldığım için, konu ve ne yapmak istediğiniz hakkında bir fikrim yok.

Halit Bey konuya vakıf olduğu için, ilgilenecektir.

.

 

[yesimgurol]

Takipte olmanız mutlu ediyor açıkçası, Halit Bey
Ben ekleme yapacağım kodları yinede başka bir sayfada oluşturmaya devam edeyim. Çünkü baya bir kullanışlı olmuştu benim için Eklemeleri de kendi kendime yapabiliyordum.

 

[Haluk]

Yeşim Hanım;

Probleminize çözüm olur mu bilmiyorum ama ...... aşağıdaki basit kodu inceleyip kendinize uyarlayabilirseniz, belki size yardımcı olur.

Aşağıdakileri boş bir modüle yapıştırıp, Test isimli makroyu çalıştırın. Bu makro, A1 ile A2000 aralığındaki hücrelere 1'den 2000'e kadar olan sayıları yazacak, kodun sonunda ise, Devam1 isimli makroyu kendisi çalıştıracak ve böylece A5000'e kadar işlem devam edecektir.

Burada yaptığımız iş, esasında tek bir makronun yapacağı işi 2 makroya bölmek oldu.

Dikkat edilmesi gereken konu ise; Devam1 isimli makroda kullanılan j değişkenin ilk değerini aldığı i değişkenini, modülün en tepesinde deklare edip, bütün prosedürlerde kullanılabilmesini sağladık.

Sizin çalışmanızdaki makroda muhtemelen böyle değişkenler vardır. Bu yöntemi uygulayarak bir deneme yapabilirsiniz...

Dim i As Integer
'
Sub Test()
    For i = 1 To 2000
        Cells(i, 1) = i
    Next
   
    Call Devam1
End Sub
'
Sub Devam1()
    For j = i To 5000
        Cells(j, 1) = j
    Next
End Sub

.

 

[yesimgurol]

Haluk bey, teşekkür ederim,ilginize ve önerinize
Kodu 2'ye bölmek aklıma gelmişti ve fazla gelenleri ayırıp denedim. Sizin vermiş olduğunuz şekliyle de uyarlamaya çalıştım. Yani ilk büyük olan makro çalıştı arkasından da eklediğimiz diğer makro çalıştı. Buraya kadar normal. Fakat büyük olan makro içerisinde 64 adet olasılık var, yani belirlemiş olduğumuz bu 64 olasılığı değerlendirip sonucu veriyor. (Her satır için)
İki ye böldüğüm de ise, ikinci yani devamı olacak olan makroya bu 64 olasılığın dışında olanları ekliyorum. Örneğin 7 adet daha ekledim. Bu devemı olacak olan makroyu da ilk makronun sonuna entegre ettim.
Çalıştırdığım da ise , 64 olasılık değerlendiriliyor sonra devamı olan makro devreye girdiğinde , 7 olasılığa göre sonuçlar alınıyor. Son makro o olduğu için.
Bu şekilde olunca da çözüm olmuyor:-(
Son mesajınızda demek istediğinizi anladım. Lakin burada bütün iş 15 satırda oluyor. 1 satır içinde bulunan 6 değerin 64 adet bulunabilme olasılığına bakıp sonucu veriyor.

 

[halit3]

Şu an bir haftadır başka bir yerdeyim bir kaç gün sonra dönmüş olacağım o zaman detaylı bakarız.
Bu dosyada a ktar1,aktar2 ,aktar3 makroları u bölümü bulun var aktar2 de ( 'buraya ekleme yapınızz") ve ekleme yapın daha sonra burası belli bir kod satırını geçerse aktar3 de aynısını yapın

 

[Haluk]

Yeşim Hanım,

Bu kalabalık mesajların arasında bulduğum bir dosyadaki kodları dediğim gibi ikiye böldüm.

Kodun verdiği sonuçlar doğru mu değil mi bilmiyorum. Siz bir deneyin isterseniz.

Dosyadaki aktar2000 isimli makroyu çalıştırın ...

.

 

[yesimgurol]

Şu an bir haftadır başka bir yerdeyim bir kaç gün sonra dönmüş olacağım o zaman detaylı bakarız.
Bu dosyada a ktar1,aktar2 ,aktar3 makroları u bölümü bulun var aktar2 de ( 'buraya ekleme yapınızz") ve ekleme yapın daha sonra burası belli bir kod satırını geçerse aktar3 de aynısını yapın

Halit bey, merhabalar..
Anlamak adına bir sorum olacaktı. Aktar 1 de 64 adet kod bloku var, sanırım aktar 2 olan kısım , aktar 1'in devamı niteliğinde olacak şekilde ayarladınız. Aktar 2 de dolunca , aktar 3 ile devam edilecek değil mi? Yanlış anlamıyorum umarım.

 

[halit3]

Halit bey, merhabalar..
Anlamak adına bir sorum olacaktı. Aktar 1 de 64 adet kod bloku var, sanırım aktar 2 olan kısım , aktar 1'in devamı niteliğinde olacak şekilde ayarladınız. Aktar 2 de dolunca , aktar 3 ile devam edilecek değil mi? Yanlış anlamıyorum umarım.

evet