key de macro ile taşımada sorun

[aatoş]

merhaba..
elimde bir key programı var.burada ilgili kişi yılda yoksa ait olduğu yılıın aylarını boş veya 0 yazdırsın.programdaki 23 hücreden sonraki kayıtlar gibi olması gerekiyor.orada düşeyara ile yaptım ama aynısını macroyla (sizin yardımınızla oluşmuş) yapmak istedim.yapamadım her zaman ki gibi yardımlarınızı bekliyorum.şimdiden emeği geçen arkadaşlara teşekkürler...kolay gelsin

 

[hamitcan]

Sub bul2()

ad = Worksheets(ActiveSheet.Name).Cells(3, 4).Value
If ad = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
sut = 9
' Worksheets(ActiveSheet.Name).Range("C9:O17").ClearContents
[color=red][c9:n17] = 0[/color]
For r = 1 To ActiveWorkbook.Sheets.Count
If ActiveSheet.Name <> Sheets(r).Name Then
deger = Sheets(r).Name
Set d = Worksheets(deger).Range("A10:A1000").Find(ad, LookAt:=xlWhole)

If Not d Is Nothing Then
firstAddress = d.Address

Do
sat = d.Row
For i = 4 To 16
Worksheets(ActiveSheet.Name).Cells(sut, i - 1).Value = Worksheets(deger).Cells(sat, i).Value
Next
Set d = Worksheets(deger).Range("A10:A1000").FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
sut = sut + 1
End If
End If

Next r
MsgBox sut & "  adet bulundu"
End Sub

şeklinde deneyin.

 

[aatoş]

günaydın

teşekkürler hamitcan bey.tam istedigim gibi olmuş.bu yardımınız benim için çok hayra geçti.Emeğinize sağlık.Sizler ve formumuz iyiki var.inanın siz ve form sayesinde o kadar işleri hallettik ki o kadar kolaylıklar sağladınız ki hepinize ayrı ayrı teşekkürler kolay gelsin....

 

[aatoş]

tekrar merhaba hamitcan bey

macronuzu tekrar tekrar farklı kayıtlara uyguladım yalnız tek bir durumda istedigimi vermedi kişi eğer o yılda yoksa o yılın butün aylarını sıfırlamıyor.diyelim ki 1987 de kişi yok 1988 de var bu macroyla 88 yılının bilgilerini 87 yazıyor.tekrar ilgilenirseniz sevinirim.dosyada ayfer örneginde olduğu gibi

 

[hamitcan]

Makroyu ben yazmadım öncelikle belirteyim, ayrıca [c9:n17] = 0 olarak yazdığım satırı [c9:n17] = " " şeklinde değiştirmişsiniz anlam veremedim.

Sub bul2()

ad = Worksheets(ActiveSheet.Name).Cells(3, 4).Value
If ad = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
sut = 9
' Worksheets(ActiveSheet.Name).Range("C9:O17").ClearContents
[c9:n17] = 0
For r = 1 To ActiveWorkbook.Sheets.Count
If ActiveSheet.Name <> Sheets(r).Name Then
deger = Sheets(r).Name
Set d = Worksheets(deger).Range("A10:A1000").Find(ad, LookAt:=xlWhole)

If Not d Is Nothing Then
firstAddress = d.Address
sut = sut + 1
Do
sat = d.Row
For i = 4 To 16
Worksheets(ActiveSheet.Name).Cells(sut, i - 1).Value = Worksheets(deger).Cells(sat, i).Value
Next
Set d = Worksheets(deger).Range("A10:A1000").FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress

End If
End If

Next r
MsgBox sut & "  adet bulundu"
End Sub

 

[aatoş]

merhaba

öncelikle ilgi ve alakanıza teşekkürler.şu an için işlem çalışıyor.ben orda " " olarak degiştirmemin nedeni 0 yerine boşluk yaparsam oluyormu acaba mantığı idi.ben macrodan anlamadığım için öğrenme yolunu bu şekilde denemelerle yaptığımdan değiştirdim,acaba öyleside olabilir mi mantığı idi.tekrar elinize sağlık kolay gelsin iyi çalışmalar.......