[ÇÖZÜLDÜ] Analistede bir kritere göre satırı başka sayfaya almak?

[cems]

Değerli arkadaşlar ,
Aşağı doğru 20 000 satır ve sapa doğru da 40 hücreden oluşan bir data içinde, tek bir kritere göre (var veya yok ) satırı olduğu gibi (kabul veya red) sayfalarına aktarmam , üstelik aktarma bitince her iki sayfayı da üçüncü kolonda olmak zorunda olan tarihe göre kendi sayfasının içinde sıralamam gerek.

Ekte, problemimin basitleştirilmiş bir örneği var , ancak aslı 20 000 satır ve 40 hücreden oluşup , aşağı ve sağa doğru genişlemeye de devam ediyor.

Her hafta da ana dataya yeni bilgiler eklendiğinden haftada 1 de dağıtımı tazelemem de gerekiyor.
Nasıl bir kod düzeni ile bunu başarmak mümkün olur ?

 

[metinozlu]

özet tablo sizin problemi çözer. örnek dosya ektedir.

 

[cems]

Sayın metinozlu ,
Öncelikle ilgi ve örneğiniz için çok teşekkür ederim , örnek üzerinde dediğiniz gibi problemi çözdü , birebir sıkıntıyı halletti.
Ancak , asıl dosyada dediğim gibi sağa doğru 40 kadar hücrenin içeriklerine göre de işlem yapmak gerektiğinden yani satırın tamamını görmek gerektiğinden ve özet tablodan dinamik olarak nasıl faydalanacağımı da iyi bilmediğimden , ilk sayfadaki tuşa bağlanacak bir makro ile satırı kritere göre sayfa seçerek taşımak daha rahatlatıcı olacak gibi.
Zira , bu sayfayı her ne kadar ben oluşturuyor olsam da kullanıcılar farklı kişi ve departmanlar olacak , dolayısı ile tuş+makro daha sorunsuz kullanım getirebilir.
Yine de ben bu özet tablo üzerinde , usta arkadaşların verebileceği bir makro örneğine kadar çalışıp iyice anladıktan sonra karşılaştıracağım.
Emeğiniz harika yine de , teşekkür ederim

 

[cems]

Özet tabloyu hala kavramaya çalışıyorum . Aslında arasıra çıkan sonuçlara göre çok da güzel ayırarak listeliyor ancak zorluk dinamik olmaması ve yeniden kurma gereği.
Ustalarımızın önereceği Makro belki daha personele kullandırılır olacak.

Kısaca
"DATA sayfasındaki F sütununda ne zaman "var" bulursa kabul sayfasına SATIRIN tamamını kopyala ve ne zaman "yok" bulursan RED sayfasına SATIRIN tamamını kopyala ve bunu F sütununda boş hücre görünceye kadar yap ve dur "
şeklinde bir döngüye ihtiyacım var

 

[cems]

Henüz inceleyen olmamış galiba

 

[cems]

Bu problemi kısmen şöyle çözdüm:
DATA ve EKSIK sayfalarını ana programdan ayırdıktan sonra DATA sayfasının kod sayfasına ;
Private Sub Worksheet_Activate()
'On Error Resume Next
' If Intersect(Target, [m7:m65536]) Is Nothing Then Exit Sub
For i = 1 To [m65536].End(3).Row
If Range("M" & i) <> "TAMAM" Then
Rows(i).Copy
s = s + 1
Sheets("EKSIK").Range("a" & s).PasteSpecial Paste:=xlValue
End If
Next
Application.CutCopyMode = False
End Sub

Kodlar&#305;n&#305; yap&#305;&#351;t&#305;rd&#305;m ve vba'n&#305;n kendisinden &#231;al&#305;&#351;t&#305;rd&#305;m , gerekli olan (tamam) yazmayan h&#252;crenin bulundu&#287;u sat&#305;r&#305; EKSIK sayfas&#305;na altalta ald&#305;. Buraya kadar problem &#231;&#246;z&#252;ld&#252;.
Devam eden sorun ise , worksheet_activate nedeni ile DATA sayfas&#305;na ge&#231;ti&#287;imde kodlar kendili&#287;inden &#231;al&#305;&#351;maya ba&#351;l&#305;yor ve durmuyor , escape ile durduruyorum , listeyi de &#231;&#305;karm&#305;yor.
Bir d&#252;&#287;me alt&#305;na bu kodlar&#305; at&#305;p &#231;al&#305;&#351;t&#305;rd&#305;&#287;&#305;mda ise , ay&#305;klanan sat&#305;rlar normal olarak 125 adet iken , b&#246;l&#252;k p&#246;r&#231;&#252;k 7500 sat&#305;ra ( ara sat&#305;rlar bo&#351; ) da&#287;&#305;t&#305;yor ve bo&#351;lar&#305; silmek gerekiyor. Bo&#351;lar&#305; silince liste gene do&#287;ru ama u&#287;ra&#351;t&#305;r&#305;c&#305;.
Kodlarda neyi d&#252;zeltmem gerek ?

 

[Orion1]

Dosya ektedir.

Sub aktar()
Dim hcr As Range, sat As Long, baslangic As Date, son As Date
Sheets("DATA").Select
baslangic = Time
Application.ScreenUpdating = False
Sheets("KABUL").Range("A4:AN65536").Clear
Sheets("RED").Range("A4:AN65536").Clear
For Each hcr In Range("A4:A" & Cells(65536, "A").End(xlUp).Row)
    If hcr.Offset(0, 3).Value = "UNIVERSITE" Or _
    hcr.Offset(0, 3).Value = "LİSE" And hcr.Offset(0, 4).Value = "VAR" _
    And hcr.Offset(0, 5).Value = "VAR" Then
        Set s = Sheets("KABUL")
        Else
        Set s = Sheets("RED")
    End If
    sat = s.Cells(65536, "A").End(xlUp).Row + 1
    s.Range(s.Cells(sat, "A"), s.Cells(sat, "AN")).Value = _
    Range(Cells(hcr.Row, "A"), Cells(hcr.Row, "AN")).Value
Next hcr
Application.ScreenUpdating = True
son = Time
MsgBox "Başlangıç : " & vbTab & Format(baslangic, "hh:mm:ss") & vbLf _
& "Son       :" & vbTab & Format(son, "hh:mm:ss") & vbLf _
& "Sonuc    = " & Format(son - baslangic, "hh:mm:ss") & vbLf & _
"İşlem Tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[cems]

Say&#305;n Evren Gizlen ,
Tam i&#351;ten &#231;&#305;karken deste&#287;inizi farkettim , evde deneyerek sonucu bildirece&#287;im.
Te&#351;ekk&#252;r ederim

Yok dayanamad&#305;m , iki dakika kopyalayarak denedim , saniye s&#252;rmedi &#246;rnekte ve do&#287;ru &#231;al&#305;&#351;t&#305; , dosyan&#305;n kendisinde de ayn&#305; ila&#231; etkisini g&#246;sterece&#287;ine eminim

Harikas&#305;n&#305;z , saatlerimi kurtard&#305;n&#305;z , allah raz&#305; olsun sizden

 

[Orion1]

Sayın Evren Gizlen ,
Tam işten çıkarken desteğinizi farkettim , evde deneyerek sonucu bildireceğim.
Teşekkür ederim

Yok dayanamadım , iki dakika kopyalayarak denedim , saniye sürmedi örnekte ve doğru çalıştı , dosyanın kendisinde de aynı ilaç etkisini göstereceğine eminim

Harikasınız , saatlerimi kurtardınız , allah razı olsun sizden

Rica ederim.
O sizin harikalığınız.