Gruplar Arasında Otomatik Sıralama

[badmad34]

Arkadaşlar merhaba,

Ekteki çalışma kitabında görülebileceği üzere, A sütununda Grup bilgisi bulunmaktadır. Benim yapmak istediğim şey şudur:

Örneğin; A grubuna ait verileri ele alalım. A grubuna ait veriler arasında en küçük tarih değeri (03.01.2013) bulunsun ve bu satıra ait İŞE BAŞLAMA TARİHİ bilgisi bu en küçük tarihle aynı değere (03.01.2013) eşit olsun.

Bundan sonra, A grubuna ait ikinci en küçük değer bulunsun ve İŞE BAŞLAMA TARİHİ bilgisi, demin girilmiş olan en küçük değerden (03.01.2013), 30 gün sonraki değere (02.02.2013) eşit olsun.

Bundan sonra ise aynı işlem A grubundaki üçüncü en küçük değer için yapılsın ve İŞE BAŞLAMA TARİHİ bilgisi, ikinci değer için girilmiş değerden (02.02.2013), 30 gün sonraki değere (04.03.2013) eşit olsun.

Bu işlem A grubundaki bütün veriler için yapılsın ve sonra B grubuna geçilsin. B gurubu bittikten sonra ise C grubuna geçilsin ve her bir değer için İŞE BAŞLAMA TARİHİ bilgisi atansın otomatik olarak.

Bu işlemi kod olmadan formülle çözmem mümkün müdür?

 

[YUSUF44]

Tablonun olması gereken son halini de gösterseydiniz daha iyi olurdu.

 

[YUSUF44]

Yine de anlayabildiğim kadarıyla formülle değil ama aşağıdaki makro koduyla hallettim diye düşünüyorum:

Sub Makro1()
a = Range("a" & Rows.Count).End(xlUp).Row
Range("B4").Select
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key _
        :=Range("A2:A" & a), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key _
        :=Range("B2:B" & a), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R1C1:RC[-2],RC[-2])=1,RC[-1],R[-1]C+30)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C" & a)
    Range("C2:C10").Select
    Range("C4").Select
 
End Sub

Bir modüle ekleyip deneyiniz.

 

[ymalkoc61]

Seçili satırları bir sütuna göre sıralama!!!

Arkadaşlar bir sıralama sorum olacak, bir türlü yapamadım. Örnek dosya ektedir. Bir sütunda belirli gruplara ayrılmış ve örnekte olduğu gibi farklı renklendirilmiş olan grupları kendi içinde her hangi bir sütuna göre büyükten küçüğe veya tersi olarak sıralamak mümkün mü? Örnek olarak, sarı renkli grubu C stünuna göre küçükten büyüğe nasıl sıralayabilirim. Yardımlarınızı bekliyorum.

 

[Erdal]

Merhabalar eki inceleyiniz.

 

[ymalkoc61]

İlginiz için teşekkür ederim. Benim istediğim aynı renkte herhangi bir sütuna göre sıraladığım zaman o renkteki tüm satırların o sütuna göre değişmesi. Yani excelin normal sırlama yaptırmasında olduğu gibi, tek fark tüm satırlar için değil, belirli satırlarlar için olması.

 

[ymalkoc61]

Arkadaşlar çözümlerinizi bekliyorum, benim konu arada kaynadı mı acaba

 

[YUSUF44]

Aşağıdaki kodları bir modüle ekleyin. Makroyu çalıştırdığınızda size hangi yılı istediğinizi soracaktır. Yıl girdiğinizde o yılın verilerini A sütunundan J sütununa kadar seçer. Daha sonra sıralama işlemini normal veri menüsünden yapabilirsiniz.

Sub sirala()
yıl = InputBox("Yıl giriniz")
 Set c = [b:b].Find(yıl)
If Not c Is Nothing Then c.Select
    Range(Cells(c.Row, 1), Cells(c.Row, "j")).Select
    Range(Selection, Selection.End(xlDown)).Select
End Sub

Tabi kodlar örneğinizdeki gibi her yıl için en az bir boşluk satırı bıraktığınıza göre düzenlenmiştir. iki yıl arasındaki boşluğu silerseniz belirttiğiniz yıldan sonraki yılı da seçer. Eğer bunun dışında her yıl için 12 satır standar olarak yer alıyorsa kodlar aşağıdaki gibi değiştirilebilir:

Sub sirala()
yıl = InputBox("Yıl giriniz")
 Set c = [b:b].Find(yıl)
If Not c Is Nothing Then c.Select
    Range(Cells(c.Row, 1), Cells(c.Row + 11, "j")).Select
End Sub

 

[ymalkoc61]

Teşekür ederim Yusuf44.

 

[badmad34]

Yine de anlayabildiğim kadarıyla formülle değil ama aşağıdaki makro koduyla hallettim diye düşünüyorum:

Sub Makro1()
a = Range("a" & Rows.Count).End(xlUp).Row
Range("B4").Select
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key _
        :=Range("A2:A" & a), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key _
        :=Range("B2:B" & a), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R1C1:RC[-2],RC[-2])=1,RC[-1],R[-1]C+30)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C" & a)
    Range("C2:C10").Select
    Range("C4").Select
 
End Sub

Bir modüle ekleyip deneyiniz.

Çok teşekkür ederim, istediğim tam olarak buydu.