Hastane İstatistik Çalışması

[erol.azakli]

Hastane Ýstatistik Çalışması

Merhaba arkadaşlar

Sizlerden ricam; sayfa1 deki G sütunundaki birbirine benzer hastalık teşhisleri arasından, yalnızca benzersiz kayıtların seçilip AS sütununa otomatik olarak (as sütunundaki görüldüğü gibi aktarılması) aktarılması. Bunu filtre uygulamadaki gelişmiş filtre ile yapmak mümkün. Yalnız o benim işim için yeterli değil. Fakat benim yapmak istediğim, bunun makro ile veya formül ile bir şekilde sayfa1 deki AS sütununa aynı sütunda görüldüğü gibi otomatik olarak aktarılması. Ondan sonra hastalık kodlarının Form 53-A daki B sütununa otomatik olarak alt alta sayfadaki boşluk sayısına göre bölüştürülüp, alt alta (Form53-A daki B sütununda görüldüğü gibi) aktarılması.

Zamanını ayırıp okuyan ve emek verecek olana herkese şimdiden teşekkürü borç bilirim.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:5cc3d7c49d]Sub benzersiz()
Application.Calculation = xlManual
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("FORM 53-A")
s1.Columns("as").ClearContents
For a = 8 To s1.[g65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("g8:g" & a), s1.Cells(a, "g")) = 1 Then
c = c + 1
s1.Cells(c + 7, "bz") = s1.Cells(a, "g")
s1.[bz8:bz65536].Sort Key1:=s1.[bz8]
End If
Next
s2.Columns("b").ClearContents
For b = 8 To s1.[bz65536].End(3).Row
d = d + 1
If d Mod 23 = 0 Then e = e + 29
say = WorksheetFunction.CountA(s1.[as8:as65536]) + 8
s1.Cells(say, "as") = "Hastalık"
s1.Cells(say + 1, "as") = s1.Cells(b, "bz")
s2.Cells(d + 19 + e, "b") = s1.Cells(b, "bz")
Next
s1.Columns("bz").ClearContents
Application.Calculation = xlAutomatic
End Sub[/vb:1:5cc3d7c49d]

 

[erol.azakli]

Hastane Ýstatistik Çalışması

Merhabalar
Çok teşekkür ederim. Tam istediğim gibi olmuş.

 

[erol.azakli]

Re: Hastane Ýstatistik Çalışması

Arkadaşlar özür diliyorum kodların çalıştığını söylemiştim fakat ufak bir problemim çıktı. Form53-A daki Sayfa1 kodlar formdaki satır sayısına göre denk gelmekte, fakat Sayfa2 ye geldiğimiz zaman kodlar sayfadaki 23 satır sayısına denk gelmemekte, bir alt satırın boş olması gerekirken (yani B93) aynı zamanda B93 de kod yazmakta. Form53-A daki Sayfa3 de B121 den başlayacağı yere B123 den başlamakta. Buda sayfalardaki verilerin kaymasına neden olmaktadır.

Bu konuda yardımcı olabilirmisiniz.

 

[Levent Menteşoğlu]

Form53-A sayfasının B sütununda her doldurulan satırdan sonraki boş olan satır sayılarının eşit olması gerekir. Sizin dosyada ikinci formdan sonra 1 eksiliyor. 100.satırdan sonra bir boş satır ekleyin. 152.satırdan sonra iki satır ekleyin. Yani boşluk sayılarını eşit yapın.

 

[erol.azakli]

Hastane Ýstatistik Çalışması

Form53-A sayfasının B sütununda her doldurulan satırdan sonraki boş olan satır sayılarının eşit olması gerekir demiştiniz her sayfadaki satır sayılarını eşitledim fakat bu sefer sayfa2 ye 22 adet kod atacağı yere 23 adet kod attı. Bu nedenle sayfa3 deki kodlarda otomatikmen normal yazılacağı satırdan 1 satır alta yazdı. Dediğiniz gibi de olmadı ne yapmamı tavsiye edersiniz.

 

[Levent Menteşoğlu]

Ekteki dosyayı inceleyin. Kod içindede küçük bir düzeltme yaptım.

 

[erol.azakli]

Hastane Ýstatistik Çalışması

Zaman ayırdığınız ve emek verdiğiniz için teşekkür ederim, kontrolünü yaptım herhangi bir problem çıkmadı. Program biraz büyük olduğu için bazı sayfaları silmek zorunda kaldım, ihtiyacı olan varsa (erolazakli_52@hotmail.com) gönderebilirim.

 

[erol.azakli]

Merhabalar
Ekteki tablodaki süz makrosunu uzun zamandır kullanıyorum. Fakat makro normalde Sayfa1 deki g sütunundaki verileri as sütununa alfabetik sıraya göre atıyor fakat daha sonradan yeni bir veri ekleyin ikinci bir kere daha benzersiz kayıtları süzdüğümde bu sefer kodları en son harften itibaren as sütünuna atıyor. (D17.1 hastalık kodu ile başlaması gerekirken, K40.9 başlıyor)
Bu konuda yardımcı olabilirmisiniz.

Sub benzersiz()
Application.Calculation = xlManual
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("FORM 53-A")
s1.Columns("as").ClearContents
For a = 9 To s1.[g65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("g9:g" & a), s1.Cells(a, "g")) = 1 Then
c = c + 1
s1.Cells(c + 7, "bz") = s1.Cells(a, "g")
s1.[bz8:bz65536].Sort Key1:=s1.[bz8]
End If
Next
s2.Columns("b").ClearContents
For b = 9 To s1.[bz65536].End(3).Row
say = WorksheetFunction.CountA(s1.[as8:as65536]) + 9
s1.Cells(say, "as") = "Hastalık"
s1.Cells(say + 1, "as") = s1.Cells(b, "bz")
s2.Cells(d + 20 + e, "b") = s1.Cells(b, "bz")
d = d + 1
If d Mod 57 = 0 Then e = e + 21
Next
s1.Columns("bz").ClearContents
Application.Calculation = xlAutomatic
End Sub