Verileri süzme ve sayfalara yerleştirme

[tetrax]

bir tablom var.
bu tablomun bir sütunundaki hücre değerlerini baz alıp süzme işlemi yapacağım.
sütundaki veriler tekrarlanabiliyor.

karışık şekilde dizilmiş ve tekrarlanabilen bu değerlerden aynı olanları gruplayıp bir araya toplayarak ayrı bir sayfaya düzenli bir şekilde yazmak istiyorum.

şöyle söyleyeyim;
bir makina olacak (makro).
önümdeki karışık kuruyemiş tabağından,
leblebileri ayıtlayıp ayrı bir tabağa,
fıstıkları ayıklayıp ayrı bir tabağa,
çekirdekleri ayıklayıp ayrı bir tabağa
.........
.........
koyacak.

hazır eli değmişken, bu tabakları kendisi seçip kendisi etiketleyecek.
yani raftan bir tabak alıp, içine leblebileri yerleştirip, üstüne "leblebi" diye kendisi etiket vuracak.

ekte excel üzerinde hazırladığım problemim var.
ayrıntılı bir şekilde anlatabildiğimi umarım.

yardımcı olabilir misiniz ?

 

[Necdet]

Merhaba,

Aşağıdaki linki inceler misiniz?

http://www.excel.web.tr/showthread.php?t=41564

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub aktar()
Dim i As Integer, k As Integer, sat As Long, var As Byte
Dim sat2 As Long, sat3 As Long, adr1 As String, adr2 As String
Sheets("Genel").Select
Application.ScreenUpdating = False
sat = Cells(65536, "H").End(xlUp).Row
If sat < 2 Then
    Application.ScreenUpdating = True
    Exit Sub
End If
For i = 2 To Cells(65536, "H").End(xlUp).Row
    For k = 1 To Worksheets.Count
        If Sheets(k).Name = Cells(i, "H").Value Then
            var = 1
            Exit For
         End If
    Next k
    If var = 1 Then
        var = 0
        Else
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets("Genel").Select
        Sheets(Sheets.Count).Name = Cells(i, "H").Value
        MsgBox "[ " & Cells(i, "H").Value & " ] İsminde Yeni Bir Sayfa Eklendi.", vbOKOnly + vbInformation, "DİKKAT"
    End If
    Sheets(Cells(i, "H").Value).Range("A2:E65536").ClearContents
    sat2 = 2
    sat3 = Cells(65536, "A").End(xlUp).Row
    If sat3 < 2 Then
        Application.ScreenUpdating = True
        Exit Sub
    End If
    For j = 2 To sat3
        If Cells(j, "A").Value = Cells(i, "H").Value Then
            adr1 = Range(Cells(j, "A"), Cells(j, "E")).Address
            adr2 = Range(Cells(sat2, "A"), Cells(sat2, "E")).Address
            Sheets(Cells(i, "H").Value).Range(adr2).Value = Range(adr1).Value
            sat2 = sat2 + 1
        End If
    Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamam.Aktarma Bitti..!!", vbOKOnly + vbInformation, "AKTARMA"
End Sub

 

[Galus]

Sayın Orion2 hocam,

Çok güzel olmuş. Arşive çektim, teşekkürler..

 

[Orion1]

Sayın Orion2 hocam,

Çok güzel olmuş. Arşive çektim, teşekkürler..

Rica ederim.
İyi çalışmalar.

 

[tetrax]

Sayın Necdet hocam,
verdiğiniz linki inceledim.
verileri süzerek ilgili sayfasına aktarma konusunda hayli bilgilendim,
teşekkür ederim.

ancak sözkonusu linkteki örnekte sayfalar önceden yaratılmıştı.
sayfa isimlerinin sabit olduğu anlaşılıyor.
tıpkı şehir isimleri gibi bilinen ve değişmeyeceği varsayılan isimler.
örnek dosyada herhangi bir sayfayı sildiğimde makro hata verdi ilgili sayfanın bulunamadığını söyledi. çünkü verileri yerleştirmek için o sayfayı arıyordu.

benim örneğimde sayfa isimleri sabit değil. değişebiliyor.
mesela bir işyerinde çalışan insanların isimleri gibi.
şehir isimleri gibi değişmeyeceği varsayılan, sürekli sabit kalacağı düşünülen veriler değil yani. bugün ali işten çıkar, yarın veli işe girer. ve benim bu isimleri önceden tahmin edebilme yeteneğim yok.

işyerinde çalışan insanların isimleri dediğime bakmayın siz, sadece bir örnek, belki farkı anlatmak için yeterince uygun olmayabilir ama o anda aklıma bu geldi ve söyleyiverdim.

ilginiz için çok teşekkür ederim.
sağolun...

 

[Necdet]

Merhaba,

Sayın Orion2 sorunuzu yanıtlamış, bende kafanızı karıştıracak bir çözüm önereyim bari

Sayfa kontrolu için fonksiyon çağırdım, belki ilginizi çekebilir. Sayfa yoksa ilgili sayfa açılıyor ama varsa daha önce bilgi olsa bile baştan aktarılıyor.

Dolayısıyla makroyu defalarca çalıştırsanız bile açılan yada var olan sayfalar hep yeniden aktarılır.

Public Sub Sayfalara_Dagit()
Application.ScreenUpdating = False
Set s1 = Sheets("Genel")
SonSatır = [A65536].End(3).Row
SonKolon = [A1].End(2).Column
s1.Select
Range(Cells(2, "A"), Cells(SonSatır, SonKolon)).Sort Key1:=[A2]
Eski_Satır = 2
Sayfa_Adı = Cells(2, "A")
For i = 2 To SonSatır + 1
    If Cells(i, "A") <> Sayfa_Adı Then
       Sayfa_Yoksa_Olustur Sayfa_Adı
       Range(Cells(1, 1), Cells(1, SonKolon)).Copy Sheets(Sayfa_Adı).[A1]
       Range(Cells(Eski_Satır, "A"), Cells(i - 1, SonKolon)).Copy _
                Sheets(Sayfa_Adı).[A2]
       Eski_Satır = i
       Sayfa_Adı = Cells(i, "A")
    End If
Next i
End Sub
 
 
 
Public Static Function Sayfa_Yoksa_Olustur(Sayfa_Adı)
Sayfa_Var_Mı = 0
For i = 1 To Sheets.Count
    If Sayfa_Adı = Sheets(i).Name Then
        Sayfa_Var_Mı = 1
        Sheets(i).Cells.Clear
        Exit For
    End If
Next i
If Sayfa_Var_Mı = 0 Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Sayfa_Adı
    Sheets("Genel").Select
End If
End Function

 

[Orion1]

Sayın tetrax benim 3 numaralı mesajda eklediğim dosyaya baktınızmı?

 

[tetrax]

Sayın Orion2 hocam;

beklediğimden çok daha fazlasını verdiniz.

öğrenmek için sordum.
elimde örnek bir çalışma bulunması amacıyla.
çok farklı alanlarda bu örnek olay kullanılabilir diye.
herhangi bir hücreyi toplama, çıkarma, çarpma yok,
bölme yok, hesap-kitap yok.

çok genel ve bir o kadar da basit bir
"arayıp bul ve istenilen yere bırak" problemi.
elbette forumda pekçok örneği var ancak genellikle özel,
kendine has problemler bunlar ve pek çoğu da karmaşık hesaplamalar içeriyor.

eğilip bükülmeye, istenen amaç doğrultusunda geliştirilmeye,
hesap-kitap işlemlerinden önceki altyapıyı hazırlamaya uygun
genel ve basit bir problem yaratmaya çalıştım.

pek çok arkadaşa faydası olacağını düşünüyorum.

galus'un da dediği gibi mükemmel bir çözüm olmuş.

tabiri caizse üstüne bir de cila çekmişsiniz, hiç bir şeyi eksik bırakmamışsınız.

çok teşekkür ederim hocam ...
elleriniz dert görmesin...

 

[Orion1]

Sayın Orion2 hocam;

beklediğimden çok daha fazlasını verdiniz.

öğrenmek için sordum.
elimde örnek bir çalışma bulunması amacıyla.
çok farklı alanlarda bu örnek olay kullanılabilir diye.
herhangi bir hücreyi toplama, çıkarma, çarpma yok,
bölme yok, hesap-kitap yok.

çok genel ve bir o kadar da basit bir
"arayıp bul ve istenilen yere bırak" problemi.
elbette forumda pekçok örneği var ancak genellikle özel,
kendine has problemler bunlar ve pek çoğu da karmaşık hesaplamalar içeriyor.

eğilip bükülmeye, istenen amaç doğrultusunda geliştirilmeye,
hesap-kitap işlemlerinden önceki altyapıyı hazırlamaya uygun
genel ve basit bir problem yaratmaya çalıştım.

pek çok arkadaşa faydası olacağını düşünüyorum.

galus'un da dediği gibi mükemmel bir çözüm olmuş.

tabiri caizse üstüne bir de cila çekmişsiniz, hiç bir şeyi eksik bırakmamışsınız.

çok teşekkür ederim hocam ...
elleriniz dert görmesin...

Rica ederim.
İyi çalışmalar.

 

[tetrax]

Merhaba,

Sayın Orion2 sorunuzu yanıtlamış, bende kafanızı karıştıracak bir çözüm önereyim bari

Sayfa kontrolu için fonksiyon çağırdım, belki ilginizi çekebilir. Sayfa yoksa ilgili sayfa açılıyor ama varsa daha önce bilgi olsa bile baştan aktarılıyor.

Dolayısıyla makroyu defalarca çalıştırsanız bile açılan yada var olan sayfalar hep yeniden aktarılır.

----------
---------

---------


Sayın Necdet hocam;

hani bir reklam vardır,
"küçük bir lezzet farkı, küçük bir mutluluktur" der.

o hesap, sizin farklı bakış açınız ayrı bir lezzet kattı olaya.

örneğinizi denedim ve mükemmel çalışıyor.

sayın Orion2 ve sizin kodlarınızı derinlemesine incelemem lazım.
sonuçta öğrenmeye çalışıyoruz.

beni gideceğim yere götüren bütün yolları bilmeliyim.
yarın birgün tek bildiğim yol trafiğe kapatılırsa,
kalakalmayayım yolun ortasında diye.

çok sağolun hocam.
elleriniz dert görmesin...

 

[Ali]

Farklı bir örnekte benden olsun.

Ekle-Ad Tanımla kısmında A:E aralığınızdaki alan veritabanı

=Sayfa1!$A$1:$E$50000 olarak kabul edildi.

Örnek dosya ektedir.

 

[mt621]

DeĞİŞİklİk

sayfa isimlerini "A"dan değilde "L"den almasını ve aktardığı verinin silinmemesini ayarlamaya çalıştım fakat başarılı olamadım.
Yardım ederseniz sevinirim..