Aşı istatistiği ay sonu formu

[omeryılmaz]

Merhaba Arkadaşlar...

Sağlık çalışanlarının kullandığı Aşı hizmetlerine ilişkin bir çalışma yapmaya çalıştım, ancak aşağıda ve dosyada ayrıntılı olarak açıkladığım bazı yerlerde yardımınıza ve desteğinize ihtiyacım var.


Seçilen Sayfaya ( ÖN2013 veya ARKA2013...) göre aylık olarak verileri süzerek bu Aylıkistatistik sayfasına getiriyorum.

1. Sorum: Çok uzun (230) sütunlu işlem olduğu için modül uzun sürüyor..
Daha kısa seri şekle nasıl getirebilirim.

2. sorum: Aile Hekimleri Sayfasından Aile Hekimlerini ÖN2013 veya ARKA2013.... sayfaları "B" sütunlarına nasıl aktarabilirim

3.Sorum : 59 03 001 ile başlayan Aile Hekimlerinin notlarını ÖN2013 veya ARKA2013.... sayfaları "B" sütunlarından nasıl buraya aldırabilirim

Yardım ve önerileriniz için şükranlarımı sunuyorum...

 

[omeryılmaz]

Merhaba Arkadaşlar.

Yukarıda kayıtlı dosyada mevcut bu kodu nasıl kısaltabilirim, İşlem uzun sürüyor.

İlginiz içi şimdiden şükranlarımı sunuyorum...

Private Sub CommandButton1_Click()
Dim s As Long, i As Long
Onay = MsgBox("Bilgileri aktarmak istiyor musunuz ?", vbYesNo + vbExclamation, "ONAY")
If Onay = vbNo Then Exit Sub
If Onay = vbYes Then

Set s1 = Sheets(ComboBox1.Text)
Set s2 = Sheets("İSTATİSTİK")


s2.Range("A4:NT6500").ClearContents

s1.Range("A1:NT3").Copy s2.Range("A1")
CommandButton4_Click

s = 4

For i = 4 To s1.Range("c65536").End(3).Row

If s1.Cells(i, 3).Value = ComboBox2.Text Then

On Error Resume Next

'Cells(s, 1).Value = s1.Cells(i, 1).Value
'Cells(s, 2).Value = s1.Cells(i, 2).Value
Cells(s, 3).Value = s1.Cells(i, 3).Value
Cells(s, 4).Value = s1.Cells(i, 4).Value
Cells(s, 5).Value = s1.Cells(i, 5).Value
Cells(s, 6).Value = s1.Cells(i, 6).Value
Cells(s, 7).Value = s1.Cells(i, 7).Value
Cells(s, 8).Value = s1.Cells(i, 8).Value
Cells(s, 9).Value = s1.Cells(i, 9).Value
Cells(s, 10).Value = s1.Cells(i, 10).Value
Cells(s, 11).Value = s1.Cells(i, 11).Value
Cells(s, 12).Value = s1.Cells(i, 12).Value
Cells(s, 13).Value = s1.Cells(i, 13).Value
Cells(s, 14).Value = s1.Cells(i, 14).Value
Cells(s, 15).Value = s1.Cells(i, 15).Value
Cells(s, 16).Value = s1.Cells(i, 16).Value
Cells(s, 17).Value = s1.Cells(i, 17).Value
Cells(s, 18).Value = s1.Cells(i, 18).Value
Cells(s, 19).Value = s1.Cells(i, 19).Value
Cells(s, 20).Value = s1.Cells(i, 20).Value
Cells(s, 21).Value = s1.Cells(i, 21).Value
Cells(s, 22).Value = s1.Cells(i, 22).Value
Cells(s, 23).Value = s1.Cells(i, 23).Value
Cells(s, 24).Value = s1.Cells(i, 24).Value
Cells(s, 25).Value = s1.Cells(i, 25).Value
Cells(s, 26).Value = s1.Cells(i, 26).Value
Cells(s, 27).Value = s1.Cells(i, 27).Value
Cells(s, 28).Value = s1.Cells(i, 28).Value
Cells(s, 29).Value = s1.Cells(i, 29).Value
Cells(s, 30).Value = s1.Cells(i, 30).Value
Cells(s, 31).Value = s1.Cells(i, 31).Value
Cells(s, 32).Value = s1.Cells(i, 32).Value
Cells(s, 33).Value = s1.Cells(i, 33).Value
Cells(s, 34).Value = s1.Cells(i, 34).Value
Cells(s, 35).Value = s1.Cells(i, 35).Value
Cells(s, 36).Value = s1.Cells(i, 36).Value
Cells(s, 37).Value = s1.Cells(i, 37).Value
Cells(s, 38).Value = s1.Cells(i, 38).Value
Cells(s, 39).Value = s1.Cells(i, 39).Value
Cells(s, 40).Value = s1.Cells(i, 40).Value
Cells(s, 41).Value = s1.Cells(i, 41).Value
Cells(s, 42).Value = s1.Cells(i, 42).Value
Cells(s, 43).Value = s1.Cells(i, 43).Value
Cells(s, 44).Value = s1.Cells(i, 44).Value
Cells(s, 45).Value = s1.Cells(i, 45).Value
Cells(s, 46).Value = s1.Cells(i, 46).Value
Cells(s, 47).Value = s1.Cells(i, 47).Value
Cells(s, 48).Value = s1.Cells(i, 48).Value
Cells(s, 49).Value = s1.Cells(i, 49).Value
Cells(s, 50).Value = s1.Cells(i, 50).Value
Cells(s, 51).Value = s1.Cells(i, 51).Value
Cells(s, 52).Value = s1.Cells(i, 52).Value
Cells(s, 53).Value = s1.Cells(i, 53).Value
Cells(s, 54).Value = s1.Cells(i, 54).Value
Cells(s, 55).Value = s1.Cells(i, 55).Value
Cells(s, 56).Value = s1.Cells(i, 56).Value
Cells(s, 57).Value = s1.Cells(i, 57).Value
Cells(s, 58).Value = s1.Cells(i, 58).Value
Cells(s, 59).Value = s1.Cells(i, 59).Value
Cells(s, 60).Value = s1.Cells(i, 60).Value
Cells(s, 61).Value = s1.Cells(i, 61).Value
Cells(s, 62).Value = s1.Cells(i, 62).Value
Cells(s, 63).Value = s1.Cells(i, 63).Value
Cells(s, 64).Value = s1.Cells(i, 64).Value
Cells(s, 65).Value = s1.Cells(i, 65).Value
Cells(s, 66).Value = s1.Cells(i, 66).Value
Cells(s, 67).Value = s1.Cells(i, 67).Value
Cells(s, 68).Value = s1.Cells(i, 68).Value
Cells(s, 69).Value = s1.Cells(i, 69).Value
Cells(s, 70).Value = s1.Cells(i, 70).Value
Cells(s, 71).Value = s1.Cells(i, 71).Value
Cells(s, 72).Value = s1.Cells(i, 72).Value
Cells(s, 73).Value = s1.Cells(i, 73).Value
Cells(s, 74).Value = s1.Cells(i, 74).Value
Cells(s, 75).Value = s1.Cells(i, 75).Value
Cells(s, 76).Value = s1.Cells(i, 76).Value
Cells(s, 77).Value = s1.Cells(i, 77).Value
Cells(s, 78).Value = s1.Cells(i, 78).Value
Cells(s, 79).Value = s1.Cells(i, 79).Value
Cells(s, 80).Value = s1.Cells(i, 80).Value
Cells(s, 81).Value = s1.Cells(i, 81).Value
Cells(s, 82).Value = s1.Cells(i, 82).Value
Cells(s, 83).Value = s1.Cells(i, 83).Value

' NT (384) sütununa kadar veri uzuyor....

s = s + 1
End If
Next i


End If
MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub

 

[mersilen]

Merhaba
Kopyala yapıştır daha rahat olmaz mı?

 Sheets("s1").Range("A" & i & ":BB" & i).Copy
   
Cells(s, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

 

[omeryılmaz]

Merhaba
Kopyala yapıştır daha rahat olmaz mı?

 Sheets("s1").Range("A" & i & ":BB" & i).Copy
   
Cells(s, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

İlginiz için şükranlarımı sunuyorum. Ellerine sağlık...

 

[mersilen]

Kopyala--özel yapıştır/değerler denincede mi sorun oluyor.
Eğer böyle ise küçük bir tablo ekleyebilir misiniz?

 

[omeryılmaz]

Kopyala--özel yapıştır/değerler denincede mi sorun oluyor.
Eğer böyle ise küçük bir tablo ekleyebilir misiniz?

Hocam Eline sağlık bu konu sizin yardımınızla aynen çözüldü,

Çözülmeyen Aile hekimleri sekmesindeki Hekim Numaralarının Ön2013 ve Arka2013 sekmelerinde "B" sütununda yerlerine aktarmak


Bu konuda da yardımcı olursanız minnettar olurum sağ olun...

 

[mersilen]

Merhaba,
Sağlık işi olunca konu ilgimi çekti.
Bundan sonra dosya eklemesi yaparken lütfen küçük dosya şeklinde eklenti yapmaya dikkat edelim.Rar olursa daha da iyi.
Daha önceki forum konularında birleştirilmiş hücre kullanmamaya özen gösterin diye not kullanıyorlardı.Şimdi sizin tabloları görünce bunu daha iyi anladım.Sizde mümkünse kullanmayın.

Ön2013 sayfasındaki B sütunundaki birleştirilmiş hücreleri iptal edip , o kısımlara tekrar edecek şekilde yazarsanız aşağıdaki kod işinizi görecektir.Diğer sayfayada benzer uygulama yapabilirsiniz.
Kolay gelsin.

Sub aktar()
For i = 4 To 82
ay = Cells(i, "c").Value
For a = 4 To 1029
If Cells(i, "B").Value = Sheets("ÖN2013").Cells(a, "B").Value And Cells(i, "C").Value = Sheets("ÖN2013").Cells(a, "c").Value Then

Sheets("ÖN2013").Range("D" & a & ":NT" & a).Copy
Cells(i, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

End If
Next a
Next i
End Sub