Kendi arasında sıralama

[ASLAN7410]

Kendi arasında sıra no verme

Merhaba arkadaşlar hayırlı Cumalar.

Ekte gönderdiğim örnek sayfada kişileri bürosuna göre kendi arasında sıralama yapmak istiyorum.

Yardım edecek arkadaşlara teşekkürler.

http://s6.dosya.tc/server3/sbr4y4/Yeni_klasor.rar.html

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[ASLAN7410]

Sayın Muygun ilginiz için çok teşekkür ediyorum.

Yazmış olduğunuz kod içerisine küçük bir eklenti daha yapılırsa güzel olacak. A sütunu kendisi yazıp sıralama yapıyor, ancak B sütunuda kendisi yazıp sıralamasını istiyorum.

Sayfayı ekte gönderiyorum.

 

[muygun]

Merhaba;
İlk dosyanızda;
"C sütunundaki rütbe sırasını kontrol ederek B sütunda kendi arasında sıralamasını istiyorum.
Sıralama içerisinden bir personeli sildiğim zamanda A sütununa göre, B sütunu C sütununu kontrol ederek sıralama yapmasını istiyorum."
Şeklinde yönlendirmeniz vardı.
Yani önce C sütununa göre Sonra B sütununa göre sıralama yapılıyor. (buna göre makro doğru işlem yapıyor)
Şimdi anladığım;
C sütununa göre sıralama yapılacak, Sıra No ve Büro sıra no yeniden düzenlenecekse;
eki deneyin.
İyi çalışmalar.

 

[ASLAN7410]

Günaydın Sayın Muygun ilginize ve emeğinize çok teşekkür ediyorum, tam istediğim gibi oldu.

Hayırlı çalışmalar.

 

[ASLAN7410]

Merhaba hayırlı geceler, konu aynı konu olduğu için yeniden konu açmak istemedim.

Daha önceden sayın muygun'un 4 nolu mesajındaki hazırlamış olduğu örnekteki kodlarda bazı yerlerde değişiklik yapmaya çalıştım, çok uğraştım ama başaramadım.

Yapmak istediğim B sütunundaki isimlere göre A sütununda kendi arasında sıralama yapmak ve dokuma şeklinde renklendirmek istiyorum.

Yardımcı olur musunuz?

 

[ASLAN7410]

Merhaba arkadaşlar maalesef çözemedim.

Sayın muygun'un aşağıdaki yazmış olduğu kodu B sütunundaki verilere göre A sütununa kendi arasında sıra no vermesini istiyorum.

Bu kodu bir türlü kendi sayfama düzenleyemedim.
Yardımcı olur musunuz?

Sub KendiArasındaSıraNoVer()
Application.ScreenUpdating = False
On Error Resume Next
Range("a2:b65536").Select
    Selection.ClearContents
    Range("a2").Select
Set s1 = ThisWorkbook.Worksheets(ActiveSheet.Name)
For i = 2 To s1.Range("c65536").End(xlUp).Row
s1.Cells(i, 19) = WorksheetFunction.SumIf(Range("R4:R65536"), s1.Cells(i, 18), Range("I4:I65536"))
s1.Cells(i, 1) = i - 1
s1.Cells(i, 2) = WorksheetFunction.CountIf(Range("c2:c" & i), Cells(i, 3))
Next i
Application.ScreenUpdating = True
End Sub

 

[Ziynettin]

Merhaba,

#6 nolu mesjdaki ekli dosyanıza göre,

Sub Sıra_Renk()
Dim Son As Integer, Alan As Range
    Son = Range("A" & Rows.Count).End(3).Row
    Set Alan = Range("A2:K" & Son)
    Alan.Sort [B2], 1, [A2], , 1
Renk_No = Array(6, 15, "")
Set d = CreateObject("Scripting.Dictionary")
    For Each X In Range("B2:B" & Son)
        If X <> "" Then
            d(X.Value) = d(X.Value)
            [COLOR="Red"]x.Offset(0, -1) = d(x.Value)[/COLOR]
        End If
    Next X
    For Each X In Range("B2:B" & Son)
        If X <> "" Then
            p = (Application.Match(X.Value, d.keys, 0)) Mod UBound(Renk_No)
            X.Offset(0, -1).Resize(, 11).Interior.ColorIndex = Renk_No(p)
        End If
    Next X
    MsgBox "İşlem Tamam.", vbInformation
End Sub

 

[ASLAN7410]

Sayın Ziynettin Bey ilginize çok teşekkür ederim, ellerinize sağlık.

Göndermiş olduğunuz örneği indirdiğimde renkleri ve A sütunundaki rakamları siliyorum, butona bastığımda B sütunundaki verilere göre kendi arasında sıra no vermiyor, sadece renklendirme yapıyor.

 

[ASLAN7410]

Sayın Ziynettin Bey, Sayın İdris SERDAR Bey'in aşağıda yazmış olduğu örnek formülle koşullu biçimlendirmeyi çözdüm.

=MOD(TOPLA.ÇARPIM(--($B$2:$B2<>$B$3:$B3));2)

Benim istediğim sadece B sütununa göre A sütununda kendi arasında sıra no vermesini istiyorum.

 

[Ziynettin]

Kod içindeki kırmızı yazılı satırı ekeyip deneyin. Ekli Dosya güncellendi.


Site çok yavaş açılıyor bende, siz de nasıl bilgi verebilirmisiniz.

 

[ASLAN7410]

Sayın Ziynettin Bey benim istediğim gibi olmuyor, yine aynı sonucu veriyor.
Sayfadaki A sütunundaki sayıları silip sayfadaki renkleri kaldırıp butona bastığımda A sütununda sıra no vermiyor ve renklenmiyor.

Ayrıca sitede biraz yavaş çalışıyor.

 

[ASLAN7410]

Benim istediğim B sütunundaki verilere göre A sütununa kendi arasında sıra no vermesini istiyorum.

 

[Ziynettin]

Ekli dosyayı tekrar deneyiniz.

 

[ASLAN7410]

Sayın Ziynettin Bey ellerinize sağlık tam istediğim gibi oldu Allah razı olsun, sizi uğraştırdım kusura bakmayın.

Küçük bir sorum olacak, bu makroyu başka bir dosyada kullanmak istediğimde örneğin veriler D sütununda, sıra no vermek istediğim verilerde C sütununda olursa nereleri değiştirmem gerekiyor.

Makro yazmaktan anlamadığım için soruyorum, Sayın muygun'un yazmış olduğu kodlarda bazı değişiklikler yaptığımda bu işlemi başaramadığım için bu konuyu tekrar sormuştum.

 

[Ziynettin]

Sayın Ziynettin Bey ellerinize sağlık tam istediğim gibi oldu Allah razı olsun, sizi uğraştırdım kusura bakmayın.

Küçük bir sorum olacak, bu makroyu başka bir dosyada kullanmak istediğimde örneğin veriler D sütununda, sıra no vermek istediğim verilerde C sütununda olursa nereleri değiştirmem gerekiyor.

Makro yazmaktan anlamadığım için soruyorum, Sayın muygun'un yazmış olduğu kodlarda bazı değişiklikler yaptığımda bu işlemi başaramadığım için bu konuyu tekrar sormuştum.

Sub Sıra_D_Sutunu()
Dim Son As Integer, Alan As Range
    Son = Range("D" & Rows.Count).End(3).Row
    Set Alan = Range("A2:K" & Son)
    Alan.Sort [B2], 1
Renk_No = Array(6, 15, "")
Set d = CreateObject("Scripting.Dictionary")
    For Each x In Range("D2:D" & Son)
        If x <> "" Then
            d(x.Value) = d(x.Value) + 1
            x.Offset(0, -1) = d(x.Value)
        End If
    Next x
    For Each x In Range("D2:D" & Son)
        If x <> "" Then
            p = (Application.Match(x.Value, d.keys, 0)) Mod UBound(Renk_No)
            x.Offset(0, -3).Resize(, 11).Interior.ColorIndex = Renk_No(p)
        End If
    Next x
    MsgBox "İşlem Tamam.", vbInformation
End Sub

 

[ASLAN7410]

Sayın Ziynettin Bey çok teşekkür ediyorum, hayırlı geceler hayırlı çalışmalar diliyorum.