Kurum adına göre 5 Ayrı rapor alma

[DeliBalta58]

Yakın bir arkadaşımla birlikte bir pogram hazırlamaktayız.(Daha doğrusu Ş.... abi ilgilenmekte bizde yanında ögrenmeye gayret ediyoruz)
Oda sıkıntıyı aşmak için araştırma yapmakta.

Çalışmasına uzun zaman önce başladığım Evrak Arşiv ve otomasyon programı sona yaklaştıkça iş zorlaşmakta.

Kurumumuza gelen –giden evrak kaydının yapılabildiği kategorilere göre rapor düzenlenebildiği bir program.

Büyük bir çoğunluğu bitti ancak en önemli bölümü olan istatistik konusunda kullandığım kodlar bayağı uzun. Buda programın çalışmasında hantallaşmasına neden olmakta.
Program çalıştırıldığında “Arşiv İşlemleri” bölümünde istatistik hazırlama kısmı şuan sadece GELEN EVRAK için düzenlemesi bitti. Ancak buda 35 birim için tek tek yapıldı.
Tarihe göre Gelen evrak, Günlük Gelen evrak İki Tarih arası gelen evrak istatistiği ve de giden kısmı da olacak.

Şimdi Sıkıntım kodların çok uzun olması ve Eğer yeni bir birim girildiğinde yani 36. Birim girildiğinde Ne olacak? Program yeniden revize edilmesi gerekecek. Bu sorunu ortadan kaldırmalıyız.

Yaptığımız işlem;

'----- >Evrak< Raporla------ 
TextBox29.Value = Sayfa1.[AA2].Value & " İşlemi Yapılıyor... " 
If Sayfa1.[AA2] = "" Then GoTo atla 
Sheets("sayfa5").Select 
Cells.Select 
Selection.ClearContents 
Selection.ColumnWidth = 11.86 
Range("A1").Select 
Sheets("sayfa9").Select 
Range("A2").Select 
Selection.AutoFilter 
Selection.AutoFilter field:=20, Criteria1:=Sayfa1.[AA2] 
ActiveCell.CurrentRegion.Select 
Selection.Copy 
Range("A1").Select 
Sheets("sayfa5").Select 
ActiveSheet.Paste 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I200]) 
Sayfa7.[B4] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I201]) 
Sayfa7.[C4] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I202]) 
Sayfa7.[D4] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I203]) 
Sayfa7.[E4] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I204]) 
Sayfa7.[F4] = bulut 
TextBox29.Value = Sayfa1.[AA2].Value & " İşlemi Bitti " 


'-----------------------------1. Şube Bitti ---------------------------- 
TextBox29.Text = Sayfa1.[AA3].Value & " İşlemi Yapılıyor " 
If Sayfa1.[AA3] = "" Then GoTo atla 
Sheets("sayfa9").Select 
Selection.AutoFilter 
Sheets("sayfa5").Select 
Cells.Select 
Selection.ClearContents 
Sheets("sayfa9").Select 
Range("A2").Select 
Selection.AutoFilter 
Selection.AutoFilter field:=20, Criteria1:=Sayfa1.[AA3] 
ActiveCell.CurrentRegion.Select 
Selection.Copy 
Sheets("sayfa5").Select 
ActiveSheet.Paste 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I200]) 
Sayfa7.[B5] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I201]) 
Sayfa7.[C5] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I202]) 
Sayfa7.[D5] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I203]) 
Sayfa7.[E5] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I204]) 
Sayfa7.[F5] = bulut 
TextBox29.Text = Sayfa1.[AA3].Value & " İşlemi Bitti " 

'-----------------------------2. Şube Bitti ---------------------------- 
TextBox29.Text = Sayfa1.[AA4].Value & " İşlemi Yapılıyor " 
If Sayfa1.[AA4] = "" Then GoTo atla 
Sheets("sayfa9").Select 
Selection.AutoFilter 
Sheets("sayfa5").Select 
Cells.Select 
Selection.ClearContents 
Sheets("sayfa9").Select 
Range("A2").Select 
Selection.AutoFilter 
Selection.AutoFilter field:=20, Criteria1:=Sayfa1.[AA4] 
ActiveCell.CurrentRegion.Select 
Selection.Copy 
Sheets("sayfa5").Select 
ActiveSheet.Paste 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I200]) 
Sayfa7.[B6] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I201]) 
Sayfa7.[c6] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I202]) 
Sayfa7.[D6] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I203]) 
Sayfa7.[E6] = bulut 
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I204]) 
Sayfa7.[F6] = bulut 
'-----------------------------3. Şube Bitti ----------------------------

Şeklinde 35 defa yazdım.

Sayfa9 da kayıtlı gelen evrak ilk önce otomatik filitre uygulanıyor. Filitrelenmiş bölüm kopyalanıyor. Bu tür işlemleri yapmak için ayırdığım Boş olan sayfa5’e yapıştırılıyor.
Burada CountIf özelliği ile Q sütununda Sayfa1 I200 ile I204 arasındaki < Evrak, Dilekçe, Şifre, E-Posta, Mesaj > olarak ayrı ayrı sayılıp Sayfa7 deki İstatistik formuna kaydediliyor.

Sıkıntı şu :
Yeni bir Birim eklendiğinde yada yeni bir evrak türü istendiğinde ne olacak.
Bu konuda yardımlarınıza ihtiyacım var.
Herkese Teşekkürler.
Program aşağıdaki linkte.
http://www.2shared.com/file/1960252/b52dd1fc/_BULUT_Resmi_Yazma_ariv.html

 

[DeliBalta58]

Cevap verecek yokmu ?

 

[Levent Menteşoğlu]

35 &#351;ubeyi yerine a&#351;a&#287;&#305;daki gibi bir d&#246;ng&#252; ile ayr&#305; ayr&#305; yazmadan i&#351;lemn yapabilirsiniz. Yeni eklenen veriler i&#231;inde koda m&#252;dahele gerekmeyecektir.

.
.
.
'-----------------------------tüm şubeler----------------------------
Set s1 = Sheets("sayfa1")
For s = 2 To s1.[aa65536].End(3).Row
TextBox29.Text = s1.Cells(s, "aa") & " İşlemi Yapılıyor "
Sheets("sayfa9").AutoFilter
Sheets("sayfa5").Cells.ClearContents
Sheets("sayfa9").Select
Range("A2").AutoFilter
Range("A2").AutoFilter field:=20, Criteria1:=s1.Cells(s, "aa")
ActiveCell.CurrentRegion.Copy Sheets("sayfa5").Paste
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I200])
Sayfa7.Cells(s + 3, "b") = bulut
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I201])
Sayfa7.Cells(s + 3, "c") = bulut
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I202])
Sayfa7.Cells(s + 3, "d") = bulut
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I203])
Sayfa7.Cells(s + 3, "e") = bulut
bulut = WorksheetFunction.CountIf(Sayfa5.Range("Q3:Q65000"), Sayfa1.[I204])
Sayfa7.Cells(s + 3, "f") = bulut
TextBox29.Text = s1.Cells(s, "aa") & " İşlemi Bitti "
Next

 

[DeliBalta58]

Elinize sa&#287;l&#305;k Te&#351;ekk&#252;rler.

 

[mehmethoca]

say&#305;n hocam bitince in&#351;allah bizimle de payla&#351;&#305;r&#351;&#305;n&#305;z
hepimizin ihtiyac&#305; olan bir &#231;al&#305;&#351;ma