sayfa1 deki sütuna yapılan sıralatma nasıl diğer sayfalarada otomatik uygulanabil

[ykaya78]

herkese saygılar.beni çok büyük zaman kayıplarından kurtarabilecek bir sorum olucak.30 sayfalık bir çalışma kitabında sayfa1 deki bir sütunda yaptırdığım a.z veya z.a tarzındaki bir sıralatmayı diğer sayfalarında aynı sütununda nasıl otomatik yaptırabilirm yardımcı olursanız beni çok mutlu edersiniz.

 

[Necdet]

Merhaba,

Sıralama yaptırdığınızda tüm sayfalarda da sıralama olsun mu istiyorsunuz? Yoksa istediğim sayfada iken sıralama yaptırayım mı diyorsunuz?

Yani bir sıralama makrosu her sayfada çalışsın mı istiyorsunuz?

Hem bu sorulara yanıt veriniz hemde basit bir örnek dosya ekleyiniz. Yardımcı olacak çok arkadaş çıkacaktır.

 

[ykaya78]

ilginiz için tesekkürler.benim istediğim ben sayfa1 de çalışırken a sütununu z.a şeklinde sıralattığım zaman diğer 30 sayfadada aynı şekilde sıralanmasını istiyorum
böyle birşey mümkün olabilirmi? şunuda belirteyim tüm sayfalardaki bilgi cinsi ve sütun sayısı aynı. örnek olarak basit bir dosyayı ekledim

 

[N.Ziya Hiçdurmaz]

Yanıt

A dan Z ye tüm sayfaları sıralar.

Sub TUMSAYFASIRALA()
Dim DEG1, AD As String
Dim I As Integer
DEG1 = InputBox("Sutun seçimi yapınız. A:D Gibi")
AD = InputBox("Hücre seçimi yapınız. A1 Gibi")
For I = 1 To Sheets.Count
Sheets(I).Select
Columns(DEG1).Select
Selection.Sort Key1:=Sheets(I).Range(AD), Order1:=xlAscending
Next
End Sub

 

[ykaya78]

çok teşekkürler çok işime yaradı.bu sıralam a.z. şeklinde. z.a şeklinde olması için nasıl bir değişiklik gerekiyo acaba?

 

[N.Ziya Hiçdurmaz]

Yanıt

Selection.Sort Key1:=Sheets(I).Range(AD), Order1:=xlDescending olarak değiştiriniz.

 

[ykaya78]

harika oldu tesekkürler tekrar.bana ne kadar zaman kazandırdığınızı bilemessiniz

 

[Necdet]

Tüm Sayfalarda Sıralama

Merhaba,

Bende sizin için uğraşmıştım, boşa gitmesin

Aşağıdaki kodları ThisWorkbook'un kod bölümüne kopyalarsanız, hangi sayfada olursanız olun ve 1. satırda herhangi bir kolonda çift tıklarsanız, Küçükten Büyüğe, Sağ tıklarsanız Büyükten Küçüğe tüm sayfalar tıkladığınız kolona göre sıralanır. Sıralanacak alanları kendisi bulur.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If Intersect(Target, [1:1]) Is Nothing Then Exit Sub
SonK = [A1].End(2).Column
SonS = [A65536].End(3).Row
If Target.Column <= SonK Then
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range(Cells(2, 1), Cells(SonS, SonK)).Sort Key1:=Cells(1, ActiveCell.Column), Order1:=1
    Next i
End If
Son:
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If Intersect(Target, [1:1]) Is Nothing Then Exit Sub
SonK = [A1].End(2).Column
SonS = [A65536].End(3).Row
If Target.Column <= SonK Then
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range(Cells(2, 1), Cells(SonS, SonK)).Sort Key1:=Cells(1, ActiveCell.Column), Order1:=2
    Next i
End If
Target.Offset(1, 0).Select
Son:
End Sub

 

[ykaya78]

Merhaba,

Bende sizin için uğraşmıştım, boşa gitmesin

Aşağıdaki kodları ThisWorkbook'un kod bölümüne kopyalarsanız, hangi sayfada olursanız olun ve 1. satırda herhangi bir kolonda çift tıklarsanız, Küçükten Büyüğe, Sağ tıklarsanız Büyükten Küçüğe tüm sayfalar tıkladığınız kolona göre sıralanır. Sıralanacak alanları kendisi bulur.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If Intersect(Target, [1:1]) Is Nothing Then Exit Sub
SonK = [A1].End(2).Column
SonS = [A65536].End(3).Row
If Target.Column <= SonK Then
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range(Cells(2, 1), Cells(SonS, SonK)).Sort Key1:=Cells(1, ActiveCell.Column), Order1:=1
    Next i
End If
Son:
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If Intersect(Target, [1:1]) Is Nothing Then Exit Sub
SonK = [A1].End(2).Column
SonS = [A65536].End(3).Row
If Target.Column <= SonK Then
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range(Cells(2, 1), Cells(SonS, SonK)).Sort Key1:=Cells(1, ActiveCell.Column), Order1:=2
    Next i
End If
Target.Offset(1, 0).Select
Son:
End Sub

öncelikle sunu söyleyeyim gerçekten çok profosyenelce ve paratik bi çalışma olmuş.ama bi yerlerde bir hata var gönderdiğiniz örnekte sıralama yaparken tüm sayfalarda değil bazı sayfalarda sıralama yapıyo.bunu halledebilirsek eminim forumdaki birçok insanın çok işine yarayacaktır.

 

[Necdet]

Haklısınız Özür Dilerim.

Tek bir sayfada çalışıyordu kodlar, genele uyarlarken ederken püf noktası gözden kaçmış Kodlar aşağıda, tekrar dener misiniz?

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If Intersect(Target, [1:1]) Is Nothing Then Exit Sub
SonK = [A1].End(2).Column
SonS = [A65536].End(3).Row
If Target.Column <= SonK Then
[B][COLOR=red]  Kolon = Target.Column[/COLOR][/B]
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range(Cells(2, 1), Cells(SonS, SonK)).Sort Key1:=Cells(1, [COLOR=red][B]Kolon[/B][/COLOR]), Order1:=1
    Next i
End If
Son:
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If Intersect(Target, [1:1]) Is Nothing Then Exit Sub
SonK = [A1].End(2).Column
SonS = [A65536].End(3).Row
If Target.Column <= SonK Then
[COLOR=red][B]  Kolon = Target.Column[/B][/COLOR]
    For i = 1 To Sheets.Count
        Sheets(i).Select
        Range(Cells(2, 1), Cells(SonS, SonK)).Sort Key1:=Cells(1,[B][COLOR=red] Kolon[/COLOR][/B]), Order1:=2
    Next i
End If
Target.Offset(1, 0).Select
Son:
End Sub

 

[ykaya78]

elinize sağlık çok güzel oldu. gerçekten çok pratik. bisey sorucam z.a sıralatırken sorun yok ama a.z sıralatırken yani çift tıklayınca her sayfayı sıralarken bir msgbox penceresi çıkıyo ve 56 173 yazıyo.yani her sayfa sıralanırken entere basmak gerekiyo.bunu nasıl halledebiliriz?

 

[Necdet]

Merhaba,

Denemek için koymuştum o mesajı, sonra farkına vardım, üstteki mesajda düzelttim. Yeniden alınız.

 

[ykaya78]

evet şu anda kusursuz oldu ve birçok insanın çok işine yarayacağına eminim çünkü insanların en çok kullandıkları fonsiyonlar bence sıralama fonksiyonları.size ve V.Basic For Applications uzmanı arkadaşımıza en derin saygılarımı sunuyorum.

 

[Necdet]

Merhaba Tekrar,

Kod sayısını teke indirmek olası.

Herhangi bir sayfada 1. satırda herhangi bir hücreye Çift Tıklandığında açılan input mesaja 1 ya da 2 kodu verildiğinde : 1 Küçükten Büyüğe, 2 ise Büyükten Küçüğe sıralar.

Yine aşağıdaki kodları ThisWorkbook'un kod bölümüne kopyalamak gerek.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Tip As Integer
On Error GoTo Son
Application.ScreenUpdating = False
Sayfa_Adı = ActiveSheet.Name
If Intersect(Target, [1:1]) Is Nothing Then Exit Sub
Kolon = Target.Column
Tip = InputBox("Nasıl Sıralama Yapmak İstiyorsunuz = 1 : A-Z, 2 : Z-A", "SIRALAMA ŞEKLİ", 1)
If Tip = 1 Or Tip = 2 Then
    SonK = [A1].End(2).Column
    SonS = [A65536].End(3).Row
    If Target.Column <= SonK Then
        For i = 1 To Sheets.Count
            Sheets(i).Select
            Range(Cells(2, 1), Cells(SonS, SonK)).Sort Key1:=Cells(1, Kolon), Order1:=Tip
        Next i
    End If
End If
Sheets(Sayfa_Adı).Select
Cells(1, Kolon).Select
Son:
End Sub