• DİKKAT

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

excelde otomatik sıralama

Merhaba

bu dosyayı daha esnek hale getirebilirmiyiz. mesela sıralanacak alanı tarayarak biz seçebilir miyiz? sıralanacak alanlar için birden fazla kriter koyabilir miyiz, örneğin sırayla A, C , E kolonlarına göre

teşekkürler
 
arkadaşlar yeni işe başladım.firmada stok sorunu var.stok tutmuyor bir türlü excell de bir program yapmak istiyorum stok programı acil lütfen yardımcı olur musunuz ?
 
Private Sub Worksheet_Change(ByVal Target As Range)
Range("A2:Z3000").Sort Key1:=Range("a2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("b1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
kodunu çalıştır dediğimde sürekli boş macros kutucuğu çıkıyor kod çalışmıyor neden acaba
 
Otomatik Sıralama

Merhaba,

Ekteki dosyada "giriş" butonu ile ekleme yaptığımda onu otomatik olarak isme ve tarihe göre sıralasın istiyorum fakat yapamadım. Mesela Berk için girdiğimde o satırı komple diğer Berklerin altına eklesin istiyorum. Sonra da Berk'in işlerini tarihe göre sıralasın istiyorum. Konuyla ilgili örneklere de baktım; fakat anlayamadım. Çok acil yardımcı olursanız çok sevinirim şimdiden teşekkürler.
 

Ekli dosyalar

Sayın Necdet Yeşertener Hocam,
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Dim Sat As Long
Dim Kolon As Integer
Dim Deger As String
Dim c As Range
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row < 4 Then Exit Sub
Kolon = [IV3].End(1).Column
Deger = Target.Value
Sat = [A65536].End(3).Row
Range(Cells(4, "A"), Cells(Sat, Kolon)).Sort Key1:=Cells(4, "A")
Set c = Range("A4:A" & Sat).Find(Deger)
Range("B" & c.Row).Select
Son:
End Sub
Bu kodlarda nasıl değişiklik yaparsanız [J4:J] arasındaki sayıları [Q4:Q] arasında sıralar, acaba? (küçükten büyüğe)
Zahmetleriniz için teşekkür ederim.
Saygılarımla
 
Sayın Necdet Yeşertener Hocam,
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Dim Sat As Long
Dim Kolon As Integer
Dim Deger As String
Dim c As Range
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row < 4 Then Exit Sub
Kolon = [IV3].End(1).Column
Deger = Target.Value
Sat = [A65536].End(3).Row
Range(Cells(4, "A"), Cells(Sat, Kolon)).Sort Key1:=Cells(4, "A")
Set c = Range("A4:A" & Sat).Find(Deger)
Range("B" & c.Row).Select
Son:
End Sub
Bu kodlarda nasıl değişiklik yaparsanız [J4:J] arasındaki sayıları [Q4:Q] arasında sıralar, acaba? (küçükten büyüğe)
Zahmetleriniz için teşekkür ederim.
Saygılarımla


Kod:
Range("J4:J65536").Copy Range("Q4")
    Application.CutCopyMode = False
    Range("Q4:Q65536").Sort Key1:=Range("Q4")

Bunu ekleyin
 
Alternatif

Yine aşağıdaki kodlar ilgili sayfanın kod bölümünde olmalı.

A sütunundaki bir değişiklikte sıralama yapar ve aynı satırı bulmaya çalışır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Dim Sat As Long
Dim Kolon As Integer
Dim Deger As String
Dim c As Range
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row < 4 Then Exit Sub
Kolon = [IV3].End(1).Column
Deger = Target.Value
Sat = [A65536].End(3).Row
Range(Cells(4, "A"), Cells(Sat, Kolon)).Sort Key1:=Cells(4, "A")
Set c = Range("A4:A" & Sat).Find(Deger)
Range("B" & c.Row).Select
Son:
End Sub

herkeze merhaba,
ben bu iki kodu birleştirmeye çalışıyorum.
bir türlü başaramadım.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SatirSay As Long
Dim Satir As Long
Dim Sayac As Long

Sayac = 1 'ilk verilecek sayı.başlangıç sayısı
If Target.Column = 2 Then
SatirSay = WorksheetFunction.CountA(Range("B1:B5000"))
For Satir = 2 To SatirSay 'kaçıncı satırdan başlayayım
Cells(Satir, 1) = Sayac 'sütun numarası
Sayac = Sayac + 1 ' kaçar kaçar üstüne koysun
Next Satir
End If
End Sub

**********

yapmaya çalıştığım sıralama şu.
1 ila 10 arasındaki bir sayının yerini değiştirince satırın yerini değiştirsin.
ki değiştiriyor.

lakin satır numarası mükerrer oluyor yukarıdan aşağı yeniden sıra numarası versin.
ki veriyor ama ayrı ayrı kodlarda
birleştirince döngüye giriyor.

sayfa karışık oldu herhalde ama rica ediyorum bi el atın.
 
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i
Dim a
If Target.Column = 2 Then
a = 1
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
a = a + 1
Cells(a, 1).Value = Cells(i, 2).Row - 1
Next
End If
End Sub

Yanlış anlamadıysam 1. sütunua sıra no vermek istiyorsunuz.
 
sayın acar6783, belirtmiş olduğunuz kod ile kendi kullanmış olduğum kodu birleştirmeye çalışıyorum.

kendi kullandığım kod. sıra numarasına göre satırı taşıyor,
aşağılarda yer alan satırı yukarı taşımak istediğimde başına 1,1 yazıyorum.
birinci satırın altına geliyor.

devamında sizin yazdığınız kodda olduğu gibi 1 , 2 , 3 diye yeniden sıra numarası versin istiyorum. ( b sütununda değişiklik yapmasını beklemesin.)

kullandığım kod.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Dim Sat As Long
Dim Kolon As Integer
Dim Deger As String
Dim c As Range
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row < 4 Then Exit Sub
Kolon = [IV3].End(1).Column
Deger = Target.Value
Sat = [A65536].End(3).Row
Range(Cells(4, "A"), Cells(Sat, Kolon)).Sort Key1:=Cells(4, "A")
Set c = Range("A4:A" & Sat).Find(Deger)
Range("B" & c.Row).Select
Son:
End Sub

sizin kod la birleştirebilirseniz mükemmel olur.
 
merhabalar,

aşağıdaki kod, küçükten büyüğe sıralama yapıyor,
peki büyükten küçüğe nasıl sıralama yaptıracağım, en büyük yukarıda olsun :(

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Dim Sat As Long
Dim Kolon As Integer
Dim Deger As String
Dim c As Range
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row < 4 Then Exit Sub
Kolon = [IV3].End(1).Column
Deger = Target.Value
Sat = [A65536].End(3).Row
Range(Cells(4, "A"), Cells(Sat, Kolon)).Sort Key1:=Cells(4, "A"),Order1:=xlDescending
Set c = Range("A4:A" & Sat).Find(Deger)
Range("B" & c.Row).Select
Son:
End Sub
 
Merhaba,

Sizin mesajda ilaveyi ekleyerek kırmızı yaptım. İlaveyi yaparsınız.

.
 
merhabalar,

ekte excel doyası mevcut,


sıralama yapılan hücreye değeri manuel olarak girince yapıyor ama ekteki dosyadanda göreceğiniz üzere formüllü yapınca sıralamıyoru :(


yardımcı olmanızı rica edebilir miyim?

teşekkürler
 

Ekli dosyalar

Herkeze merhaba.
Ben hala bir cözüm bulamadım. Yardımcı olabilecek arkadaşlara şimdiden teşekkür ediyorum.

Kod birleştirmeyi kenara koyarsak. Aşağıdaki kod ile satırı yukarı taşıdıktan sonra sıra numarası olan satırların yeniden küçükten büyüğe numaralandırılmasını istiyorum.

Aksi taktirde sıra numaraları örn. 3 ve 4 satırın no arasına girsin diye 3.1 3.2 3.3 gibi kalıyor.
Ben 3.1 diyerek satırı araya taşıdıktan sonra yeniden numaralansın istiyorum.

sayın acar6783, belirtmiş olduğunuz kod ile kendi kullanmış olduğum kodu birleştirmeye çalışıyorum.

kendi kullandığım kod. sıra numarasına göre satırı taşıyor,
aşağılarda yer alan satırı yukarı taşımak istediğimde başına 1,1 yazıyorum.
birinci satırın altına geliyor.

devamında sizin yazdığınız kodda olduğu gibi 1 , 2 , 3 diye yeniden sıra numarası versin istiyorum. ( b sütununda değişiklik yapmasını beklemesin.)

kullandığım kod.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
Dim Sat As Long
Dim Kolon As Integer
Dim Deger As String
Dim c As Range
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row < 4 Then Exit Sub
Kolon = [IV3].End(1).Column
Deger = Target.Value
Sat = [A65536].End(3).Row
Range(Cells(4, "A"), Cells(Sat, Kolon)).Sort Key1:=Cells(4, "A")
Set c = Range("A4:A" & Sat).Find(Deger)
Range("B" & c.Row).Select
Son:
End Sub

sizin kod la birleştirebilirseniz mükemmel olur.
 
Merhaba,

Düşünce başlangıçta iyiymiş gibi görünse bile büyük dosyalarda sıkıntı yaratabilir.

Bunun yerine istediğiniz zaman sıralama yapacak bir yol bulunabilinir.

Örnek dosyada herhangi bir hücreye çift tıkladığımızda tıklanan sütuna göre Küçükten Küçüğe ya da Büyükten Küçüğe sıralayan kodları göreceksiniz.

Sıralama şeklini; dosyada kullanılan son kolondan hemen sonra ve 1. satırdaki hücreye 1 ve 2 kullanarak belirleyebiliriz.

1. Küçükten Büyüğe
2. Büyükten Küçüğe

Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim SonKolon As Integer
Dim SonSatir As Long
SonKolon = [IV1].End(1).Column - 1
If Target.Column > SonKolon Then
    MsgBox "Sınırlar İçinde Kalalım Lütfennnnn :)", vbCritical, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    Exit Sub
End If
If Cells(1, SonKolon + 1) <> 1 And Cells(1, SonKolon + 1) <> 2 Then
    MsgBox "Sıralama Şekli Belli Değil, Küçükten Büyüğe Sıralamak İçin : 1, Büyükten Küçüğe Sıralamak İçin : 2 Olmalıdır " & Cells(1, SonKolon + 1)
    Cells(1, SonKolon + 1).Activate
    Exit Sub
End If
SonSatir = [A65536].End(3).Row
Range(Cells(2, 1), Cells(SonSatir, SonKolon)).Sort Key1:=Cells(1, Target.Column), Order1:=Cells(1, SonKolon + 1)
End Sub

Hocam ben bu kodu ekteki dosyama eklemek istiyorum . Yardımcı olurmusunuz .
 

Ekli dosyalar

Geri
Üst