• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

buttonla süzme işlemi yapmak

  • Konbuyu başlatan Konbuyu başlatan yuang
  • Başlangıç tarihi Başlangıç tarihi
Katılım
4 Şubat 2008
Mesajlar
24
Excel Vers. ve Dili
ms2007 türkçe
arkadaşlar ekte göndermiş olduğum örnekteki gibi herhangi bir sayfada oluşturulan verileri button yardımıyla başka bir sayfada sıralanmasını nasıl yapabiliriz? ekte göndermiş olduğum örnekteki gibi ihracat sayfasına girilen değerleri ana sayfada firmaya ait button yardımıyla sadece o firmaya ait bilgilerin firma için açılmış sayfada nasıl görüntüleyebiliriz. Yardımlarınızı bekliyorum..
 
istediğiniz böyle bir şey herhalde eke bir bakın isterseniz özür dilerim yanlış ek göndermişim güncelledim şimdi
 
Son düzenleme:
Ekli dosyayı inceleyiniz.:cool:
Kod:
Sub A_Firması()
Application.ScreenUpdating = False
Sheets("A FİRMASI").Range("A2:J65536").ClearContents
    Sheets("İHRACAT").Select
    If Sheets("İHRACAT").FilterMode Then ActiveSheet.ShowAllData
    Sheets("İHRACAT").Range("E14").AutoFilter Field:=5, Criteria1:="A FİRMASI"
    sonsat = Cells(65536, "A").End(xlUp).Row
    Range(Cells(15, "A"), Cells(sonsat, "M")).Copy
    Sheets("A FİRMASI").Select
    Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub
Sub B_firması()
Sheets("B FİRMASI").Range("A2:J65536").ClearContents
    Sheets("İHRACAT").Select
    If Sheets("İHRACAT").FilterMode Then ActiveSheet.ShowAllData
    Sheets("İHRACAT").Range("E14").AutoFilter Field:=5, Criteria1:="B FİRMASI"
    sonsat = Cells(65536, "A").End(xlUp).Row
    Range(Cells(15, "A"), Cells(sonsat, "M")).Copy
    Sheets("B FİRMASI").Select
    Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Range("A1").Select

End Sub
Sub C_Firması()
Sheets("C FİRMASI").Range("A2:J65536").ClearContents
    Sheets("İHRACAT").Select
    If Sheets("İHRACAT").FilterMode Then ActiveSheet.ShowAllData
    Sheets("İHRACAT").Range("E14").AutoFilter Field:=5, Criteria1:="C FİRMASI"
    sonsat = Cells(65536, "A").End(xlUp).Row
    Range(Cells(15, "A"), Cells(sonsat, "M")).Copy
    Sheets("C FİRMASI").Select
    Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub
 
Sn. Orion ..

Kod:
Sub A_Firması()
Application.ScreenUpdating = False
Sheets("A FİRMASI").Range("A2:J65536").ClearContents
    Sheets("İHRACAT").Select
    If Sheets("İHRACAT").FilterMode Then ActiveSheet.ShowAllData
    Sheets("İHRACAT").Range("E14").AutoFilter Field:=5, Criteria1:="A FİRMASI"
    sonsat = Cells(65536, "A").End(xlUp).Row
    Range(Cells(15, "A"), Cells(sonsat, "M")).Copy
    Sheets("A FİRMASI").Select
    Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub


Sn. Orion yukarıda vermiş olduğunuz kodu kendi çalışma kitabıma uygulamaya çalışırken süzme işlemini verilen kritere göre yaptırarak sayfa2 ye yazdırabiliyorum .. ancak sayfa1 de kendiliğinden sayfa2 nin aynısı oluyor.. Yardım edermisiniz..

Kod:
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("A2:M65536").ClearContents
    Sheets("Sayfa1").Select
    If Sheets("Sayfa1").FilterMode Then ActiveSheet.ShowAllData
    Sheets("Sayfa1").Range("B2").AutoFilter Field:=2, Criteria1:=TextBox1.Value
    sonsat = Cells(65536, "A").End(xlUp).Row
    Range(Cells(2, "A"), Cells(sonsat, "M")).Copy
    Sheets("Sayfa2").Select
    Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Range("A1").Select
    tamam = MsgBox("Lütfen yeniden arama yapmadan önce TEMİZLE butonuna tıklayınız.", vbOKOnly)
If tamam Then
    ListBox1.ColumnCount = 12
ListBox1.ColumnWidths = "45;40;60;70;50;70;25;25;25;25;50"
ListBox1.RowSource = "Sayfa2!B2:M" & [a65536].End(3).Row
Me.Top = 40
Me.Left = 80
End If
Sheets("Sayfa1").Select
End Sub
Bunlarda benim uyarlamaya çalıştığım kodlar bi bakarsanız sevinirim...
Teşekkürler.
 
Sayın Iseker,Aşağıdaki gibi deneyiniz.:cool:
Kod:
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("A2:M65536").ClearContents
    Sheets("Sayfa1").Select
     Sheets("Sayfa1").Range("B2").AutoFilter Field:=2, Criteria1:=TextBox1.Value
    sonsat = Cells(65536, "A").End(xlUp).Row
    Range(Cells(2, "A"), Cells(sonsat, "M")).Copy
    [B][COLOR="Red"]If Sheets("Sayfa1").FilterMode Then ActiveSheet.ShowAllData[/COLOR][/B]    
    Sheets("Sayfa2").Select
    Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Range("A1").Select
    tamam = MsgBox("Lütfen yeniden arama yapmadan önce TEMİZLE butonuna tıklayınız.", vbOKOnly)
If tamam Then
    ListBox1.ColumnCount = 12
ListBox1.ColumnWidths = "45;40;60;70;50;70;25;25;25;25;50"
ListBox1.RowSource = "Sayfa2!B2:M" & [a65536].End(3).Row
Me.Top = 40
Me.Left = 80
End If
Sheets("Sayfa1").Select
End Sub
 
Hata..

2507hata.jpg

Maalesef resimdeki hatayı veriyor..
Örnek Teşkil etmesi açısından dosyayı ekliyorum ..
Ayrıca yardımlarınız için şimdiden teşekkürler..
 
Ekli dosyayı inceleyiniz.:cool:
Kod:
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("A2:M65536").ClearContents
    Sheets("Sayfa1").Select
    Sheets("Sayfa1").Range("B2").AutoFilter Field:=2, Criteria1:=TextBox1.Value
    sonsat = Cells(65536, "A").End(xlUp).Row
    Range(Cells(2, "A"), Cells(sonsat, "M")).Copy
    Sheets("Sayfa2").Select
    Range("A2").PasteSpecial
    [COLOR="red"][B]Sheets("Sayfa1").Select[/B][/COLOR]
   [B][COLOR="Red"] If Sheets("Sayfa1").FilterMode Then ActiveSheet.ShowAllData[/COLOR][/B]
    [COLOR="red"][B]Sheets("Sayfa2").Select[/B][/COLOR]
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Range("A1").Select
    tamam = MsgBox("Lütfen yeniden arama yapmadan önce TEMİZLE butonuna tıklayınız.", vbOKOnly)
If tamam Then
    ListBox1.ColumnCount = 12
ListBox1.ColumnWidths = "45;40;60;70;50;70;25;25;25;25;50"
ListBox1.RowSource = "Sayfa2!B2:M" & [a65536].End(3).Row
Me.Top = 40
Me.Left = 80
End If
Sheets("Sayfa1").Select
End Sub
 
Sn.Orion2 aslında yapmak istediğim şey.. Sayfa1 deki veriler içerisinde TextBox1 deki değeri süzerek ListBox1 de görüntülemek ..
Ama Sayfada süzme işlemini bir türlü yapamayınca yukarıda yazdıgınız kodu denedim.. Süzme yaparak listBox ta görüntüleyeceğim bilgileri de daha sonra çift tıklayıp textBoxlara alıp gerekli hallerde değiştirme yapabilmek istiyorum..
Yardımlarınızla becerebilirsem ne mutlu .. :)
Teşekkürler..
 
Sayın Iseker 7 numaralı mesaja eklediğim dosyaya baktınızmı?
 
Evet çok teşekkür ederim.. Sağolun ..
Ben yazarken cevap yollamışsınız..
Bir konuda daha rahatsız edebilirmiyim ....
Yukarıdaki mesajda da değindiğim gibi sayfada süzme yaparak ListBox1 de görüntüleme yaparak gerekirse süzülen sonuçlardan herhangi birini çift tıklamayla TextBox lara alarak gerekli TextBox ta değişikliği yaparak kaydetmem mümkünmü ..
Bu sorumu cevapsız bıraksanız bile Yazdığınız kod şu anda çalışıyor ve işimi görüyor... (Sorumu cevapsız bırakmanız ile anlatmak istediğim Forumda en Aktif üyelerden birisiniz.. yoğun olabileceğiniz ihtimaline karşındı .. )
İyi geceler.. Teşekkürler tekrar.
 
Yardımlarınız İçin Çok Teşekkürler
 
Geri
Üst