makro ile ilgili acil yardım.

[gezgin-49]

Sayın üstadlarım veri, Çocuklar ve Torunlar sayfasındaki verileri 2 türlü olarak karar sayfasına aktarmam gerekiyor, ama önce miras sayfasındaki veri aktarımını aşağıda kırmızı renkte belirttiğim yerlerdeki gibi değiştirmem gerekiyor. konu ile ilgili acil yardımlarınızı bekliyorum,

Sub hesapla()
Set s1 = Sheets("VERİ")
Set s2 = Sheets("ÇOCUKLAR")
Set s3 = Sheets("MİRAS")
Set s4 = Sheets("TORUNLAR")
For a = 7 To s1.[f65536].End(3).Row
If s1.Cells(a, "g") = "sağ" Then
sat = s3.[c65536].End(3).Row + 1
s3.Cells(sat, "c") = s1.Cells(a, "f")
s3.Cells(sat, "b") = "çocuğu"
End If
Next
deg = Array("A4", "F4", "K4", "A22", "F22", "K22", "A40", "F40", "K40")
sutun = Array("D", "I", "N", "D", "I", "N", "D", "I", "N")
satir = Array(7, 7, 7, 25, 25, 25, 43, 43, 43)
For a = 0 To 8
If s2.Range(deg(a)) = "" Then GoTo 10
For b = 0 To 8
If s2.Cells(satir(a) + b - 1, sutun(a)) = "var" Then
sat = s3.[c65536].End(3).Row + 1
s3.Cells(sat, "c") = s2.Cells(satir(a) + b - 1, sutun(a)).Offset(0, -2)
s3.Cells(sat, "b") = "gelini/damadı"bu kısma gelini/damadı yerine kimin eşi olduğunu yazmasını mesela AA eşi gibi, yani çocuklar sayfasında "A4", "F4", "K4", "A22", "F22", "K22", "A40", "F40", "K40" hücrelerinde yazılı evli ölen çocuklardan kimin eşi ise onu yazmasını yani AA eşi ..... diye yazması mümkün mü
End If
If s2.Cells(satir(a) + b, sutun(a)) = "sağ" Then
sat = s3.[c65536].End(3).Row + 1
s3.Cells(sat, "c") = s2.Cells(satir(a) + b, sutun(a)).Offset(0, -2)
s3.Cells(sat, "b") = "torunu"torunu yerine kimin çocuğu olduğunu yazmasını istiyorum, mesela AA çocuğu gibi
End If
Next
10 Next
For a = 0 To 5
If s4.Range(deg(a)) = "" Then GoTo 20
For b = 0 To 8
If s4.Cells(satir(a) + b - 1, sutun(a)) = "var" Then
sat = s3.[c65536].End(3).Row + 1
s3.Cells(sat, "c") = s4.Cells(satir(a) + b - 1, sutun(a)).Offset(0, -2)
s3.Cells(sat, "b") = "torunun gelini/damadı" çocuklar sayfasındaki değişecek makro ile aynı olacak
End If
If s4.Cells(satir(a) + b, sutun(a)) = "sağ" Then
sat = s3.[c65536].End(3).Row + 1
s3.Cells(sat, "c") = s4.Cells(satir(a) + b, sutun(a)).Offset(0, -2)
s3.Cells(sat, "b") = "torununun torunu"çocuklar sayfasındaki değişecek makro ile aynı olacak
End If
Next
20 Next
s3.Select
MsgBox "Miras Hesaplama İşlemi Başarı İle Yapıldı."
End Sub

 

[Levent Menteşoğlu]

Sorunuzu dosya içinde izah edermisiniz.

 

[gezgin-49]

Sayın leventm dosyayı gönderiyorum. yukarıdaki makroyu da siz yapmıştınız, o makroyu hesaplama işleminde kullanıyorum, verileri karar sayfasına dikey aktarmak için böyle bir makro gerekiyor makro şifresi : kenan saygılar sunarım.

 

[Levent Menteşoğlu]

Karar sayfasındaki mavi renkli alanlar aynı şekilde ilgili sayfalardan burayamı aktarılacaktır. O sütunundaki mavi renkli veriler nereden geliyor?

 

[gezgin-49]

Karar sayfasındaki mavi renkli alanlar aynı şekilde ilgili sayfalardan burayamı aktarılacaktır. O sütunundaki mavi renkli veriler nereden geliyor?

sayın leventm, yukarıda yapmak istediğim makro ile bulacağım verileri karar sayfasında mavi olarak gösterdiğim yere yapıştırmak istiyorum sizin sorduğunuz O sutunundaki verilerle ilgili olarak
hesaplama için daha önce yapılan makroda miras kalan kişilerin murise yakınlık derecelerini belirtirken "çocuğu, torunu, gelini/damadı, torununun gelini/damadı, torununun torunu" olarak belirtiyorduk bu hesaplama için gerekliydi, ama karar sayfasına aktarım için bu kez çocuklar sayfasındaki "A4", "F4", "K4", "A22", "F22", "K22", "A40", "F40", "K40" hücrelerinde yazılı evli ölen çocuklar ile Torunlar sayfasında da "A4", "F4", "K4", "A22", "F22", "K22" hücrelerinde yazılı evli ölen torunları sağ olan kişilerin murise yakınlık derecelerini belirtmek için kullanmak gerekiyor örneğin
miras tablosunda 5.sıradaki kişiyi ele alırsak
Sıra No Yakınlık Derecesi Adı Soyadı Miras Hissesi
5. gelini/damadı FF 24.576,00 iken


24.576,00 payın ölü AA eşi (çocuklar sayfası A4) FF' ye şeklinde

karar sayfası D32' den başlayarak aşağıya doğru dikey olarak yazmasını son kişiyi yazdıktan sonra devamla hemen yanına "AİDİYETLERİNE" yazdıktan sonra bir alt satıra geçmesini ve bu satıra "verasetin bu şekilde sübutuna" yazmasını daha sonra yine bir alt satıra geçerek "harç peşin alındığından yeniden harç alınmasına yer olmadığına" yazdıktan sonra yine bir alt satıra geçmesini ve buraya da "Dair aksi ispat oluncaya kadar geçerli olmak üzere verilen karar açıkça okunup usülen tefhim kılındı. ...../....../....... (günün tarihi)" yazarak 2 satır boş bırakmasını sol başa "katip" aynı satırda sağa yanaşık olarak "hakim" yazmasını istiyorum, bu işin dikey olarak yazılması gereken kısmı idi burayı çözümledikten sonra yatay aktarım var ona geçeceğim ama ikisi birden karışır onu bundan sonra yaparız.

 

[gezgin-49]

Sayın leventm sorum anlaşılmıştır inşaallah acil yardımlarınızı bekliyorum.

 

[gezgin-49]

makro ile iki ayrı şekilde aktarım

Sayın leventm yapmak istediğim şeyleri detayları ile birlikte ekte gönderdiğim word sayfasına aktardım, word dosyası en son sayfaya bir tane karar örneği yazdım, karar örneğinde yatay olarak kırmızı renkte belirtilen mirasçılara ait bilgiler "veri, çocuklar ve torunlar" sayfasından aktarılıyor, miras hisseleri belirtilen dikey aktarım ise veri, çocuklar, torunlar ve miras sayfalarından faydalanılarak aktarılması gereken bilgilerden oluşuyor. saygılar sunarım.
VBA PAROLASI="kenan"

 

[gezgin-49]

arkadaşlar yaptığım proğramın bir aksilik çıkmazsa son aşamasına geldim sayılır, ama şu anda tıkandım ve bir milim bile ilerliyemiyorum, biliyorum istediğim şey biraz karışık ve zaman alıcı ama lütfen yardımlarınızı esirgemeyin, ilginizden domayı şimdiden teşekkür ederim, saygılar,

 

[bedersu]

Kodlar İlerİde Mevcut OlduĞu İÇİn Buradan Kaldirdim

 

[gezgin-49]

kardeş çok özür dilerim cevap bayağı gecikti.En zor kısımlardan birisini hallettik Allah'ın izniyle.Aşağıdaki kodlar şu sonucu veriyor:

sağ eşi KARA, çocukları ZZ,EE,CC,BB,ölü AA nin eşi FF ve çocukları KK,HH,GG,ölü DD nin eşi LL ve çocukları OO,NN,MM,ölü çocuğu JJ nin eşi PP ve çocukları SS,RR,ölü çocuğu ÖÖ nin eşi ŞŞ ve çocukları ZZ,YY,VV,TT,Bir bak sorun çıkarsa yeniden bakarız.

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

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

If Sheets("veri").Cells(eii, "g") = "sağ" Then
eb = Sheets("veri").Cells(eii, "g").Offset(0, -1)
ebb = eb & "," & ebb

End If
Next
.....

End Sub

sayın bedersu ilginiz için çok teşekkür ederim, yazdığınız kodları Sub deneme() altında denedim, çalışıyor, ama verileri nereye yazıyor göremedim, bu konuda beni aydınlatırsanız memnun olurum, saygılar.

 

[bedersu]

veriyi yazmıyor ki.siz istediğiniz hücrenin adresini bu kodların altına yazacaksınız.hücreye de şunu yazdıracaksın:mesela

celss(1,1)=ea & ebbb & yaz & tyaz

 

[gezgin-49]

veriyi yazmıyor ki.siz istediğiniz hücrenin adresini bu kodların altına yazacaksınız.hücreye de şunu yazdıracaksın:mesela

celss(1,1)=ea & ebbb & yaz & tyaz

mesela ben bu verileri sayfa1 A1 hücresine yazdırmam için ne yapmam lazım

 

[bedersu]

sheets("Sayfa1").cells(1,1)=ea & ebbb & yaz & tyaz

bu kodu yukarıdaki kodun en sonuna end sub'tan hemen önce koy olacaktır.

 

[bedersu]

Kodlar İlerİde Mevcut OlduĞu İÇİn Buradan Kaldirdim

 

[gezgin-49]

sheets("Sayfa1").cells(1,1)=ea & ebbb & yaz & tyaz

bu kodu yukarıdaki kodun en sonuna end sub'tan hemen önce koy olacaktır.

Sayın bedersu ALLAH sizden razı olsun tam istediğim gibi ama bu sadece yapmak istediğimim birinci ayağı idi, ikinci ayağı da bu verileri miras payları ile birlikte yukarıdan aşağıya doğru karar sayfasının sonuna yazdırmak ve son kişiyi yazdıktan sonra "AİDİYETLERİNE" ve sorumda belirttiğim yazıları alt alta yazmaktı, bu konularda da yardımlarınıza ihtiyacım olacak, Rabbim sizi iki cihanda aziz etsin, yüzünüzü ak etsin, hesabınızı kolay etsin, böyle yardımsever iyi insanlarla yüzünü görmesem de tanışmak beni çok mutlu ediyor, Allah razı olsun ellerinize sağlık, sağolun, varolun. Saygılar sunarım.

 

[bedersu]

İLK YAZILACAK OLAN BU kısmından sonra else koyun yani:

If Sheets("veri").Range("G3") = "sağ" Then
ea = "sağ eşi " & Sheets("veri").Range("G4") & ", " 'İLK YAZILACAK OLAN BU
else
ei = WorksheetFunction.CountA(Sheets("veri").Range("E:E "))

 

[gezgin-49]

sayın bedersu veri sayfasında belirttiğim eşlerle ilgili sorun çocuklar ve torunlar sayfasında da var bu else kodunu yukarıda belirttiğiniz yere bıraktığım zaman tüm sorunlar giderilecekmi, yoksa else komutunu İKİNCİ YAZILACAK OLAN BU, ÜÇÜNCÜ YAZILACAK OLAN BU, DÖRDÜNCÜ YAZILACAK OLAN BU kısımlarının sonuna da eklemek gerekiyormlu? benim proğram evdeki bilgisayarda kaldı bu bilgisayarlarda Adalet Bakanlığı UYAP bağlantılı olduğundan kısıtlı bir bağlantı içeriyor o da birazdan kesilecek saygılar sunuyorum,

 

[bedersu]

Tamam kardeş onunla da ilgileneceğim

 

[bedersu]

sanırım sorun kalmadı

Merhaba,
Sorun kalmadı herhalde.Hatta biraz daha geliştirdim ismin hallerini de otomatik ekletecek şekilde yaptım.Yani isim Ahmet ise otomatik oarak Ahmet'in,Duru ise Duru'nun yazıyor.Yani hepsine nin ya da nun eklemiyor.Kodlar şu şekilde:


Sub aktar()

If Sheets("veri").Range("G3") = "sağ" Then
ea = "sağ eşi " & Sheets("veri").Range("G4") & ", " 'İLK YAZILACAK OLAN BU
Else
ei = WorksheetFunction.CountA(Sheets("veri").Range("E:E"))
For eii = 8 To ei + 3

If Sheets("veri").Cells(eii, "g") = "sağ" Then
eb = Sheets("veri").Cells(eii, "g").Offset(0, -1)
ebb = eb & "," & ebb

End If
Next
ebbb = " çocukları " & ebb ' İKİNCİ YAZILACAK OLAN BU

End If





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

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

Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=c).Activate
adrs = Left(ActiveCell.Address, 2)
adres = Right(adrs, 1)
ad = Right(ActiveCell.Address, 2)
adr = Right(ad, 1)

Range(adrs & adr + 1).Select
For aa = 2 To 13
cc = ActiveCell.Offset(1, 1)
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




cc = "ölü " & c & " eşi " & cc & " ve "
If ActiveCell.Offset(1, 3) = "yok" Then cc = "ölü " & c
If ActiveCell.Offset(aa, 3) = "" Then GoTo son:

If ActiveCell.Offset(aa, 3) = "sağ" And sayı = 1 Then GoTo bir:
If ActiveCell.Offset(aa, 3) = "sağ" And sayı = 2 Then GoTo iki:
If ActiveCell.Offset(aa, 3) = "sağ" And sayı = 3 Then GoTo üç:
If ActiveCell.Offset(aa, 3) = "sağ" And sayı = 4 Then GoTo dört:
If ActiveCell.Offset(aa, 3) = "sağ" And sayı = 5 Then GoTo beş:
If ActiveCell.Offset(aa, 3) = "sağ" And sayı = 6 Then GoTo altı:
GoTo burası:
bir:
cc1 = cc
d1 = ActiveCell.Offset(aa, 1)
dd1 = d1 & "," & dd1
GoTo burası:
iki:
cc1 = cc
d1 = ActiveCell.Offset(aa, 1)
dd1 = d1 & "," & dd1
GoTo burası:

üç:
cc1 = cc
d1 = ActiveCell.Offset(aa, 1)
dd1 = d1 & "," & dd1
GoTo burası:

dört:
cc1 = cc
d1 = ActiveCell.Offset(aa, 1)
dd1 = d1 & "," & dd1
GoTo burası:

beş:
cc1 = cc
d1 = ActiveCell.Offset(aa, 1)
dd1 = d1 & "," & dd1
GoTo burası:

altı:
cc1 = cc
d1 = ActiveCell.Offset(aa, 1)
dd1 = d1 & "," & dd1

burası:

Next
son:

yaz = yaz & cc1 & " çocukları " & dd1 'ÜÇÜNCÜ YAZILACAK OLAN BU
End If

Next







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)


Sheets("ÇOCUKLAR").Activate
Cells.Find(What:=ttcc).Activate
tcadrs = Left(ActiveCell.Address, 2)
tcadres = Right(tcadrs, 1)
tcad = Right(ActiveCell.Address, 2)
tcadr = Right(tcad, 1)

Range(tcadrs & tcadr + 1).Select
For tcaa = 2 To 13


If ActiveCell.Offset(tcaa, 3) = "" Then GoTo tson:

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

Sheets("TORUNLAR").Activate
Cells.Find(What:=t).Activate
tadrs = Left(ActiveCell.Address, 2)
tadres = Right(tadrs, 1)
tad = Right(ActiveCell.Address, 2)
tadr = Right(tad, 1)
tsayı = tsayı + 1
tdd1 = ""
Range(tadrs & tadr + 1).Select


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


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

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

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

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

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

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

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

ElseIf iha = "Ü" Or iha = "Ö" Or ihaa = "Ü" Or ihaa = "Ö" Then
t = t & "'ün"
End If




For taa = 2 To 13
tcc = ActiveCell.Offset(1, 1)
tcc = "ölü çocuğu " & t & " eşi " & tcc & " ve "
If ActiveCell.Offset(1, 3) = "yok" Then tcc = "ölü çocuğu " & t

If ActiveCell.Offset(taa, 3) = "" Then GoTo tson1:

If tsayı = 1 Then GoTo tbir:
If tsayı = 2 Then GoTo tiki:
If tsayı = 3 Then GoTo tüç:
If tsayı = 4 Then GoTo tdört:
If tsayı = 5 Then GoTo tbeş:
If tsayı = 6 Then GoTo taltı:

tbir:
tcc1 = tcc
td1 = ActiveCell.Offset(taa, 1)
tdd1 = td1 & "," & tdd1
GoTo tekrar:

tiki:
tcc1 = tcc
td1 = ActiveCell.Offset(taa, 1)
tdd1 = td1 & "," & tdd1
GoTo tekrar:

tüç:
tcc1 = tcc
td1 = ActiveCell.Offset(taa, 1)
tdd1 = td1 & "," & tdd1
GoTo tekrar:

tdört:
tcc1 = tcc
td1 = ActiveCell.Offset(taa, 1)
tdd1 = td1 & "," & tdd1
GoTo tekrar:

tbeş:
tcc1 = tcc
td1 = ActiveCell.Offset(taa, 1)
tdd1 = td1 & "," & tdd1
GoTo tekrar:

taltı:
tcc1 = tcc
td1 = ActiveCell.Offset(taa, 1)
tdd1 = td1 & "," & tdd1

tekrar:
Next

End If
Next
tson1:
tyaz = tyaz & tcc1 & " çocukları " & tdd1 'DÖRDÜNCÜ YAZILACAK OLAN BU

End If

Next
tson:

Sheets("Sayfa1").Cells(1, 1) = ea & ebbb & yaz & tyaz



End Sub

 

[gezgin-49]

Merhaba,
Sorun kalmadı herhalde.Hatta biraz daha geliştirdim ismin hallerini de otomatik ekletecek şekilde yaptım.Yani isim Ahmet ise otomatik oarak Ahmet'in,Duru ise Duru'nun yazıyor.Yani hepsine nin ya da nun eklemiyor.Kodlar şu şekilde:

sayın bedersu kodları denedim, ama yine bir hata var şöyle ki:
veri sayfasında murisin eşi sağ olunca veri sayfası F8:F29 arasındaki murisin sağ olan çocuklarını aktarmıyor, bir de "in, un, ün, ın" gibi ekleri de bırakmıyor, kodlara bir daha bakarsanız memnun olurum,
ayrıca burada birşey daha sormak istiyorum, yapılan kodlamalara göre aktarılması gereken isimlerin yatay olarak aktarılmasında soy ad kullanmak gerekmiyordu, ancak dikey olarak aktarma işleminde bu kişilerin soyadlarının da yazması gerekiyor, acaba sayfayı yeniden düzenleyip örneğin veri sayfasında F8:F28 arasında soyad için iki hücreye bölmem mi gerekiyor, yoksa bunun başka kolay bir yolu varmı? saygılar sunuyorum.