• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

makro ile diğer sayfalardan veri alarak başka bir sayfaya dikey aktarma

G

gezgin-49

Altın Üye
Katılım
17 Ekim 2006
Mesajlar
669
Excel Vers. ve Dili
Türkçe 2003
arkadaşlar ekteki dosyada miras olarak hesaplanan hisselerin mirasçılara murise yakınlık derecelerine göre karar sayfasına dikey şekilde aktarılması yönünde yardım
ekteki word dosyasında resimli olarak açıklamaya çalıştım, dosya ekte gönderilmiştir, yardımlarınız için şimdiden hepinize teşekkür ediyor, saygılar sunuyorum. (Not: aktarma işlemi sayfa2' de A3 hücresinden aşağıya doğru olacak)
 
................
 
Son düzenleme:
Sayın üstadım bedersu kodları denedim, ama benim istediğim böyle değildi, miras sayfasına "miras hesapla" butonu ile zaten murisin tüm mirasçıları yazılıyor, yani sorunum o değildi, ben sayfa2 ye aşağıdaki şekilde aktarma istiyorum.

318.767,10 payın murisin sağ eşi Zahire TEKİN' e
50.331,65 payın murisin çocuğu Ali TEKİN' e
50.331,65 payın murisin çocuğu Ceyhun TEKİN' e
50.331,65 payın murisin çocuğu Davut Mert TEKİN' e
50.331,65 payın murisin çocuğu Mahmut TEKİN' e
50.331,65 payın murisin çocuğu Osman TEKİN' e
50.331,65 payın murisin çocuğu Perihan KORKMAZ' a
50.331,65 payın murisin çocuğu Recep TEKİN' e
50.331,65 payın murisin çocuğu Savaş TEKİN' e
50.331,65 payın murisin çocuğu Şerife ASLAN' a
50.331,65 payın murisin çocuğu Uğur TEKİN' e
12.582,91 payın murisin ölü çocuğu Bekir TEKİN eşi Banu TEKİN' e
7.549,75 payın murisin ölü çocuğu Bekir TEKİN çocuğu Bülent TEKİN' e
7.549,75 payın murisin ölü çocuğu Bekir TEKİN çocuğu Kamer TEKİN' e
12.582,91 payın murisin ölü çocuğu Emrah KARA TEKİN eşi Naciye TEKİN' e
37.748,74 payın murisin ölü çocuğu Emrah KARA TEKİN çocuğu Ahmet Enes TEKİN' e
....................
(sonuncu kişi)
18.874,37 payın murisin ölü torunu Emine TEKİN çocuğu Özge TEKİN' e AİDİYETLERİNE,
Verasetin bu şekilde sübutuna,
Harç peşin alındığından yeniden harç alınmasına yer olmadığına,
Dair aksik ispat oluncaya kadar verilen karar açıkça okunup usulen açıklandı. / /2007 (bugünün tarihi)
(iki satır boşluk bıraktıktan sonra sol başa "katip" aynı satırın sonuna da "Hakim" yazmasını istiyorum.(word sayfasında belirttiğim gibi) saygılar sunuyorum.
 
Merhaba,
Kodlar düzeltildi:


Sub miras_pay_isim()
çsıra = 7
If Sheets("veri").Range("G3") = "ölü" Then GoTo bura:

If Sheets("veri").Range("G3") = "sağ" Then ea = "murisin sağ eşi " & Sheets("veri").Range("G4") & ", " 'İLK YAZILACAK OLAN BU
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = ea
bura:
ei = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For eii = 8 To ei + 3

If Sheets("veri").Cells(eii, "g") = "sağ" Then



ebc = Sheets("veri").Cells(eii, "g").Offset(0, -1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If



çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = "murisin çocuğu " & ebc




End If
Next eii


i = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For ii = 8 To i + 3

If Sheets("veri").Cells(ii, "g") = "ölü" Then
c = Sheets("veri").Cells(ii, "g").Offset(0, -1)

Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=c).Activate

Range(ActiveCell.Address).Offset(1, 0).Select

ebc = ActiveCell.Offset(1, 1)
If ebc = "" Then GoTo bitir:

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = "murisin gelini/damadı " & ebc



bitir:




For aat = 2 To 13
If ActiveCell.Offset(aat, 3) = "ölü" Then GoTo yenit:
If ActiveCell.Offset(aat, 3) = "" Then GoTo gitt:
If ActiveCell.Offset(aat, 3) = "sağ" Then

ebc = ActiveCell.Offset(aat, 1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = "murisin torunu " & ebc




yenit:
End If
Next aat
End If
gitt:
Next ii


ti = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For tii = 8 To ti + 3

If Sheets("veri").Cells(tii, "g") = "ölü" Then

ttcc = Sheets("veri").Cells(tii, "g").Offset(0, -1)

For tcaa = 1 To 13


Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=ttcc).Activate
Range(ActiveCell.Address).Offset(1, 0).Select



If ActiveCell.Offset(tcaa, 3) = "ölü" Then
t = ActiveCell.Offset(tcaa, 1)

Sheets("TORUNLAR").Activate
Cells.Find(What:=t).Activate


Range(ActiveCell.Address).Offset(1, 0).Select


ebc = ActiveCell.Offset(1, 1)
If ebc = "" Then GoTo bitirc:

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = "murisin torununun gelini/damadı " & ebc



bitirc:


For aatc = 2 To 13
If ActiveCell.Offset(aatc, 3) = "ölü" Then GoTo yenitc:
If ActiveCell.Offset(aatc, 3) = "" Then GoTo gittc:
If ActiveCell.Offset(aatc, 3) = "sağ" Then


ebc = ActiveCell.Offset(aatc, 1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = "murisin torununun çocuğu " & ebc




yenitc:
End If

Next aatc
End If

gittc:
Next tcaa
End If
Next tii




End Sub
 
sayın üstadım bedersu
kodu yazdım ama çalıştırdığımda aşağıdaki kodda hata verdi.

Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
 
evet çünkü MİRAS sayfasındaki o satırlardaki formülde hata var.Bizim kodlar da değerleri bu satırlardan aldığı için bahsi geçen hücreye geldiğinde veri olmadığından hata veriyor.O hücrelere kendiniz rakam yazarsanız çalıştığını göreceksiniz.
Bunu dün ben de farkettim ama size burada belirtmeyi unuttum.Formülü düzeltmek için bakamadım.Zaten çok uzun bir formül.Mirasın nasıl hesaplandığını da anlatabilirseniz belki onu da makroyla yapabiliriz.Ya da formülü düzeltirken bize yardımcı olur açıklamalarınız.
 
Sayın üstadım bedersu, murise ait toplam mirası şu şekilde hesaplıyoruz, (yukarıdaki 1.mesajdaki dosyayı ele alamım) bu dosaya göre;
VERİ SAYFASI:murisin eşi sağ ve toplam 20 çocuğu var bu çocuklardan 9 tanesi evli ölmüş (bekar ölenlere miras yok)
ÇOCUKLAR SAYFASI:evli ölen bu çocuklardan birinci çocuğun eşi ve 5 çocuğu (2 sağ-3 ölü), ikinci ve üçüncü çocuğun eşi ve bir çocuğu, dördüncü çocuğun eşi ve iki çocuğu (biri sağ, biri ölü), beşinci çocuğun eşi yok 4 çocuğu (3 sağ-1 ölü), altıncı çocuğun eşi yok 2 sağ çocuğu, 7 çocuğun eşi ve 2 sağ çocuğu, 8 çocuğun eşi ve bir sağ çocuğu, 9 çocuğun eşi yok iki sağ çocuğu var,
TORUNLAR SAYFASI: 1 Torunun eşi ve 2 çocuğu, 2 - 3 ve 4 torunun eşi ve 1 çocuğu, 5 torunun eşi yok 2 çocuğu olduğunu varsayalım buna göre miras hesaplama şöyle oluyor.
murisin eşine 1/4 hisse, evli veya bekar ölen çocuklarına ise toplam 3/4 hisse veriliyor, çocuklardan evli ölenlerin eşlerine (evli ölen çocuğa düşen hissenin) 1/4 hissesi eşine, geriye kalan 3/4 hisse ise çocuklarına, aynı işlem tüm evli ölen çocuklar için ve aynı şekilde torunlar için yapılıyor. yani yukarıdaki tabloya göre ;
VERİ SAYFASI :4*20
ÇOCUKLAR SAYFASI:4*5*4*1*4*1*4*2*4*2*2
TORUNLAR SAYFASI:4*2*4*1*4*1*4*1*2
Şimdi bu formülleri birleştirirsek
=4*20*4*5*4*1*4*1*4*2*4*2*2*4*2*4*1*4*1*4*1*2
toplam hisse yukarıdaki çarpım sonucudur, şimdi bu hisseleri paylaştıracak olursak toplam sonucu 4' e bölerek murisin eşinin hissesini, geriye kalanı 20' ye bölerek her bir çocuğun hissesini buluruz, bundan sonra bu çocukların evli ölen çocukların mirasçılarına düşecek hisseyi bulmak için eğer eşi varsa yine bu çocuk hissesine düşen hisseyi 4' e bölerek hisse miktarını buluruz geriye kalan hisse sağ ve evli ölen çocuklarına düşen hisse miktarıdır, torunlar sayfasında mantık aynı bu şekilde yazılanlar karışık gelirse veri sayfası A31' de toplam hisseye ait formül J3 eşe düşen hisse, j8:j26 çocuklara düşen hisse, "Çocuklar" sayfası ve torunlar sayfası A37, B37, F37,G37,.......hücrelerinde evli ölenlerin eş ve çocuklarına düşen hisselere ilişkin formül, ayrıca torunlar sayfası A3, F3, K3, A21, F21, K21 hücrelerinde ise torunların toplam hisselerini hangi şekilde çocuklar sayfasından aldıklarına ilişkin formül var. saygılar sunuyorum.
 
Merhaba,

kodları şu şekilde dener misiniz?

Sub miras_pay_isim()
çsıra = 7
If Sheets("veri").Range("G3") = "ölü" Then GoTo bura:

If Sheets("veri").Range("G3") = "sağ" Then ebc = "murisin sağ eşi " & Sheets("veri").Range("G4") 'İLK YAZILACAK OLAN BU


ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If




Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = ebc



bura:
ei = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For eii = 8 To ei + 3

If Sheets("veri").Cells(eii, "g") = "sağ" Then



ebc = Sheets("veri").Cells(eii, "g").Offset(0, -1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If



çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = "murisin sağ çocuğu " & ebc




End If
Next eii


i = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For ii = 8 To i + 3

If Sheets("veri").Cells(ii, "g") = "ölü" Then
c = Sheets("veri").Cells(ii, "g").Offset(0, -1)

Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=c).Activate

ihi = Right(c, 1)
iha = Left(Right(c, 2), 1)
ihaa = Left(Right(c, 3), 1)


If ihi = "A" Or ihi = "I" Then
c = c & "'nın"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
c = c & "'ın"
End If

If ihi = "E" Or ihi = "İ" Then
c = c & "'nin"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
c = c & "'in"
End If

If ihi = "O" Or ihi = "U" Then
c = c & "'nun"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
c = c & "'un"
End If

If ihi = "Ö" Or ihi = "Ü" Then
c = c & "'nün"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
c = c & "'ün"
End If
c = "murisin ölü çocuğu " & c
Range(ActiveCell.Address).Offset(1, 0).Select

ebc = ActiveCell.Offset(1, 1)
If ebc = "" Then GoTo bitir:

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = c & " eşi " & ebc



bitir:




For aat = 2 To 13
If ActiveCell.Offset(aat, 3) = "ölü" Then GoTo yenit:
If ActiveCell.Offset(aat, 3) = "" Then GoTo gitt:
If ActiveCell.Offset(aat, 3) = "sağ" Then

ebc = ActiveCell.Offset(aat, 1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = c & " çocuğu " & ebc




yenit:
End If
Next aat
End If
gitt:
Next ii


'************TORUNLAR SAYFASI****************************************************************************************




ti = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For tii = 8 To ti + 3

If Sheets("veri").Cells(tii, "g") = "ölü" Then

ttcc = Sheets("veri").Cells(tii, "g").Offset(0, -1)

For tcaa = 1 To 13


Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=ttcc).Activate
Range(ActiveCell.Address).Offset(1, 0).Select



If ActiveCell.Offset(tcaa, 3) = "ölü" Then
c = ActiveCell.Offset(tcaa, 1)

Sheets("TORUNLAR").Activate
Cells.Find(What:=c).Activate

ihi = Right(c, 1)
iha = Left(Right(c, 2), 1)
ihaa = Left(Right(c, 3), 1)


If ihi = "A" Or ihi = "I" Then
c = c & "'nın"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
c = c & "'ın"
End If

If ihi = "E" Or ihi = "İ" Then
c = c & "'nin"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
c = c & "'in"
End If

If ihi = "O" Or ihi = "U" Then
c = c & "'nun"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
c = c & "'un"
End If

If ihi = "Ö" Or ihi = "Ü" Then
c = c & "'nün"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
c = c & "'ün"
End If
c = "murisin ölü torunu " & c



Range(ActiveCell.Address).Offset(1, 0).Select


ebc = ActiveCell.Offset(1, 1)
If ebc = "" Then GoTo bitirc:

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = c & " eşi " & ebc



bitirc:


For aatc = 2 To 13
If ActiveCell.Offset(aatc, 3) = "ölü" Then GoTo yenitc:
If ActiveCell.Offset(aatc, 3) = "" Then GoTo gittc:
If ActiveCell.Offset(aatc, 3) = "sağ" Then


ebc = ActiveCell.Offset(aatc, 1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Sayfa2").Cells(çsıra, 1) = Sheets("MİRAS").Cells(çsıra, 4) & " payın "
Sheets("Sayfa2").Cells(çsıra, 2) = c & " çocuğu " & ebc




yenitc:
End If

Next aatc
End If

gittc:
Next tcaa
End If
Next tii




End Sub
 
Sayın üstadım bedersu siz bir harikasınız, sağolun, varolun, ellerinize, emeğinize sağlık, kodlar tam istediğim gibi ama bir kaç deneme daha yapınca hata olup olmadığı belli olur, ancak ilk mesajda da belirttiğim gibi son kişiyi yazdıktan sonra ;
"AİDİYETLERİNE,
Verasetin bu şekilde sübutuna,
Harç peşin alındığından yeniden harç alınmasına yer olmadığına,
Dair aksik ispat oluncaya kadar verilen karar açıkça okunup usulen açıklandı. / /2007 (bugünün tarihi)
(iki satır boşluk bıraktıktan sonra sol başa "katip" aynı satırın sonuna da "Hakim" yazmasını da istiyorum, bunun için ne gibi bir ilave yapılması gerekiyor, saygılar sunuyorum.
 
Sub miras_pay_isim()
çsıra = 32
If Sheets("veri").Range("G3") = "ölü" Then GoTo bura:

If Sheets("veri").Range("G3") = "sağ" Then ebc = "murisin sağ eşi " & Sheets("veri").Range("G4") 'İLK YAZILACAK OLAN BU


ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If




Sheets("Karar").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar").Cells(çsıra, 3) = " payın " & ebc



bura:
ei = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For eii = 8 To ei + 3

If Sheets("veri").Cells(eii, "g") = "sağ" Then



ebc = Sheets("veri").Cells(eii, "g").Offset(0, -1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If



çsıra = çsıra + 1
Sheets("Karar").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar").Cells(çsıra, 3) = " payın murisin sağ çocuğu " & ebc




End If
Next eii


i = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For ii = 8 To i + 3

If Sheets("veri").Cells(ii, "g") = "ölü" Then
c = Sheets("veri").Cells(ii, "g").Offset(0, -1)

Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=c).Activate

ihi = Right(c, 1)
iha = Left(Right(c, 2), 1)
ihaa = Left(Right(c, 3), 1)


If ihi = "A" Or ihi = "I" Then
c = c & "'nın"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
c = c & "'ın"
End If

If ihi = "E" Or ihi = "İ" Then
c = c & "'nin"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
c = c & "'in"
End If

If ihi = "O" Or ihi = "U" Then
c = c & "'nun"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
c = c & "'un"
End If

If ihi = "Ö" Or ihi = "Ü" Then
c = c & "'nün"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
c = c & "'ün"
End If
c = "murisin ölü çocuğu " & c
Range(ActiveCell.Address).Offset(1, 0).Select

ebc = ActiveCell.Offset(1, 1)
If ebc = "" Then GoTo bitir:

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Karar").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar").Cells(çsıra, 3) = " payın " & c & " eşi " & ebc



bitir:




For aat = 2 To 13
If ActiveCell.Offset(aat, 3) = "ölü" Then GoTo yenit:
If ActiveCell.Offset(aat, 3) = "" Then GoTo gitt:
If ActiveCell.Offset(aat, 3) = "sağ" Then

ebc = ActiveCell.Offset(aat, 1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Karar").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar").Cells(çsıra, 3) = " payın " & c & " çocuğu " & ebc




yenit:
End If
Next aat
End If
gitt:
Next ii


'************TORUNLAR SAYFASI****************************************************************************************




ti = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For tii = 8 To ti + 3

If Sheets("veri").Cells(tii, "g") = "ölü" Then

ttcc = Sheets("veri").Cells(tii, "g").Offset(0, -1)

For tcaa = 1 To 13


Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=ttcc).Activate
Range(ActiveCell.Address).Offset(1, 0).Select



If ActiveCell.Offset(tcaa, 3) = "ölü" Then
c = ActiveCell.Offset(tcaa, 1)

Sheets("TORUNLAR").Activate
Cells.Find(What:=c).Activate

ihi = Right(c, 1)
iha = Left(Right(c, 2), 1)
ihaa = Left(Right(c, 3), 1)


If ihi = "A" Or ihi = "I" Then
c = c & "'nın"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
c = c & "'ın"
End If

If ihi = "E" Or ihi = "İ" Then
c = c & "'nin"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
c = c & "'in"
End If

If ihi = "O" Or ihi = "U" Then
c = c & "'nun"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
c = c & "'un"
End If

If ihi = "Ö" Or ihi = "Ü" Then
c = c & "'nün"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
c = c & "'ün"
End If
c = "murisin ölü torunu " & c



Range(ActiveCell.Address).Offset(1, 0).Select


ebc = ActiveCell.Offset(1, 1)
If ebc = "" Then GoTo bitirc:

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Karar").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar").Cells(çsıra, 3) = " payın" & c & " eşi " & ebc



bitirc:


For aatc = 2 To 13
If ActiveCell.Offset(aatc, 3) = "ölü" Then GoTo yenitc:
If ActiveCell.Offset(aatc, 3) = "" Then GoTo gittc:
If ActiveCell.Offset(aatc, 3) = "sağ" Then


ebc = ActiveCell.Offset(aatc, 1)

ihi = Right(ebc, 1)
iha = Left(Right(ebc, 2), 1)
ihaa = Left(Right(ebc, 3), 1)


If ihi = "A" Or ihi = "I" Then
ebc = ebc & "'ya"

ElseIf iha = "A" Or iha = "I" Or ihaa = "A" Or ihaa = "I" Then
ebc = ebc & "'a"
End If

If ihi = "E" Or ihi = "İ" Then
ebc = ebc & "'ye"

ElseIf iha = "İ" Or iha = "E" Or ihaa = "İ" Or ihaa = "E" Then
ebc = ebc & "'e"
End If

If ihi = "O" Or ihi = "U" Then
ebc = ebc & "'ya"

ElseIf iha = "O" Or iha = "U" Or ihaa = "O" Or ihaa = "U" Then
ebc = ebc & "'a"
End If

If ihi = "Ö" Or ihi = "Ü" Then
ebc = ebc & "'ye"

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
ebc = ebc & "'e"
End If


çsıra = çsıra + 1
Sheets("Karar").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar").Cells(çsıra, 3) = " payın" & c & " çocuğu " & ebc




yenitc:
End If

Next aatc
End If

gittc:
Next tcaa
End If
Next tii
Sheets("Karar").Cells(çsıra, 3) = c & " çocuğu " & ebc & " AİDİYETLERİNE,"
Sheets("Karar").Cells(çsıra + 1, 3) = " Verasetin bu şekilde sübutuna,"
Sheets("Karar").Cells(çsıra + 2, 3) = "Harç peşin alındığından yeniden harç alınmasına yer olmadığına,"
Sheets("Karar").Cells(çsıra + 3, 3) = "Dair verilen karar aksi ispat oluncaya kadar geçerli olmak üzere açıkça okunup usülen anlatıldı. " & Date
Sheets("Karar").Cells(çsıra + 6, 3) = "Katip"
Sheets("Karar").Cells(çsıra + 6, 9) = "Hakim"
Sheets("Karar").Activate
Range("B32:B" & çsıra).Select
Selection.NumberFormat = "#,##0.00"


End Sub
 
sayın bedersu kodları denedim ama




Sheets("Karar").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar").Cells(çsıra, 3) = " payın " & ebc



bura:
ei = WorksheetFunction.CountA(Sheets("veri").Range("E:E "))
For eii = 8 To ei + 3

If Sheets("veri").Cells(eii, "g") = "sağ" Then
renkli belirttiğim yerde hata verdi,
 
Evet,kusura bakmayın bunu yazmayı unutmuşum.Sizin dosyanızda Karar sayfasının isminden sonra bir boşluk var.Sayfa isminin sonundaki boşluğu silin ya da şu şekilde yapın:

Sheets("Karar ").Cells(çsıra, 2) = Sheets("MİRAS").Cells(çsıra - 25, 4)
Sheets("Karar ").Cells(çsıra, 3) = " payın " & ebc

ama sayfa ismini değiştirmek daha kolay ve iyi olur.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst