Şarta Bağlı Alfabetik İki Ayrı Liste Alma

[beyinmuhendisi]

Gerekli açıklama Dosyada da mevcuttur.
Bir çok şartlı liste örneklerine baktım ancak başaramadım.

"Alfabetik Sırala" butonuna bastığımda;
C sütununda, "M" işaretli olan,
B Sütunundaki öğretmen listesini L4 başlangıç L sütuna alfabetik;
C sütununda boş olan,
B Sütunundaki öğretmen listesinin de M4 başlangıç M sütununa alfabetik sıralamam gerekiyor. Olması gereken sonuç L ve M sütunlarında gösterilmiştir. Gerekli kod yardımına ihtiyacım var. İlginize teşekkür ederim!

 

[Ömer BARAN]

Merhaba.

Gördüğüm kadarıyla B sütunundaki isimler zaten alfabetik sıralı.
O halde sadece C sütunundaki M harfi kriterine göre işlem yaparak sonuç alınabilir.

Aşağıdaki kod'u ilgili sayfanın kod bölümüne uygulayın ve çalıştırın.
(alt taraftan ilgili sayfa adına fareyle sağ tıkalayıp KOD GÖDÜRTÜLE seçildiğinde açılan VBA ekranında sağdaki boş alana yapıştırın)
.

[B]Sub ALFABETIK_IKILI_LISTELE()[/B]
Range("L4:M" & Rows.Count).ClearContents
For sat = 4 To Cells(Rows.Count, "B").End(3).Row
    sut = 13
    If Cells(sat, 3) = "M" Then sut = 12
    bos = Cells(Rows.Count, sut).End(3).Row + 1
    If bos = 3 Then bos = 4
    Cells(bos, sut) = Cells(sat, 2)
Next
[B]End Sub[/B]

 

[beyinmuhendisi]

Sayın Ömer BARAN Hızır gibi yardımıma yetişiyorsunuz. Çok teşekkür ederim.
Yazdığınız kodu şu şekilde düzenledim. Emeğinize sağlık!

Sub ALFABETIK_IKILI_LISTELE()
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect ""
Range("B4:C" & Cells(Rows.Count, "B").End(3).Row).Sort key1:=[B4], ORDER1:=xlAscending
Range("L4:M" & Rows.Count).ClearContents
For sat = 4 To Cells(Rows.Count, "B").End(3).Row
sut = 13
If UCase(Cells(sat, 3)) = "M" Then sut = 12
bos = Cells(Rows.Count, sut).End(3).Row + 1
If bos = 3 Then bos = 4
Cells(bos, sut) = Cells(sat, 2)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveSheet.Protect ""
End Sub

 

[beyinmuhendisi]

Tek bir sorun var o da büyük "M", küçük "m" duyarlılığı. Bu sorunu nasıl aşabiliriz?

 

[Ömer BARAN]

Son satır numarasına ilişkin Cells(Rows.Count, "B").End(3).Row kısmını 111 olarak değiştirdiğinize göre,
B sütunundaki son dolu satır numarası sabit olmalı.

Aşağıdaki ilgili kısımları (kırmızı renklendirdim) değiştirin.
.

Range("B4:[B][COLOR="Blue"][SIZE="4"]C" & Cells(Rows.Count, "B").End(3).Row[/SIZE][/COLOR][/B]).Sort key1:=[B][COLOR="red"][SIZE="4"][B4][/SIZE][/COLOR][/B], ORDER1:=xlAscending
Range("L4:M" & Rows.Count).ClearContents
For sat = 4 To [B][COLOR="Blue"][SIZE="4"]Cells(Rows.Count, "B").End(3).Row[/SIZE][/COLOR][/B]
sut = 13
If [B][COLOR="Red"][SIZE="4"]UCase([/SIZE][/COLOR][/B]Cells(sat, 3)[B][COLOR="red"][SIZE="4"])[/SIZE][/COLOR][/B] = "M" Then sut = 12

 

[beyinmuhendisi]

Yeniden emeğinize sağlık. Teşekkür ederim.
Yardımınız sonrası 3. mesajdaki kodu güncelledim.
İyi çalışmalar!

 

[Ömer BARAN]

Bir önceki cevabımda; B:C sütununu alfabetikıralamayla ilgili satırdaki C111'i unutmuşum.
Bir önceki cevabımda değişiklik yaparak mavi renklendirdim.
Sayfayı yenileyerek bir önceki evabımı konrtol edin.

Kullandığınız belgedeki kod'da o kısmı da değiştirin.
.

 

[beyinmuhendisi]

Güncelledim. Teşekkür ederim!