Makro düzeltme!!! (Süzme işleminde font değiştirme)

shenko · 7 Kasım 2006

Aşağıdaki makroyu sorunsuz olarak kullanıyordum fakat makronun çalıştığı dosyaya her gün yeni birşeyler eklendiği için süzme işlemide koymak zorunda kaldım. Süzme işlemi yaptıktan sonra makroyu çalıştırdığımda "A" kolumuna göre sıralamayı yaptıktan sonra her başlığın yazı formatının "Arial Black" olmasında sorun oluyor. Mesela "A"kolumundaki "a" ların en başındakini, "b" lerin en başındakini, "c" lerin en başındakini "Arial Black" yapması gerekiyor. Ama yapmıyor. Yalnız süzme işlemi yokmuş gibi süzmeyi "All" yaparsam. Ozaman gayet düzgün çalışıyor.

Süzme işlemini çalıştırdığımda, sadece ekranda görünen satırlara aşağıdaki makronun çalışmasını nasıl sağlayabiliriz?

Sub Buyer_Click()
Range("A4:L65536").Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("H4") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
ActiveWindow.LargeScroll ToRight:=-1
Range("A2").Select
son = [a65536].End(3).Row
Range("a4:j" & son).Select
Selection.Font.Name = "Arial"
Selection.Sort Key1:=Range("a4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(4, 1).Font.Name = "Arial Black"
For x = 4 To son - 1
If Cells(x, 1) <> Cells(x + 1, 1) Then Cells(x + 1, 1).Font.Name = "Arial Black"
Range("B1").Select

Next
MsgBox "ALICILAR'A GÖRE SIRALANDI!"
End Sub

Levent Menteşoğlu · 7 Kasım 2006

Bu durum için özel olarak yapacak bir şey bence, yapmanız gereken kodlarınızın içine önce süzmeyi kaldıran, işlemi yaptıktan sonra süzmeyi yeniden oluşturan kodlar eklemektir.

shenko · 7 Kasım 2006

Değerli üstad Leventm,

Süzme işlemi her defasında değişik şekilde süzülmek istenicektir. Bunun için nasıl bir makro yazabilirsiniz?

Yada nasıl bir makro yazılmalı ki; makro çalıştığında süzdeki seçilmiş olan bilgileri aklında tutucak daha sonra bütün süzleri "All" yapıp, yukarıdaki makroyu çalıştırıcak ve ensonunda tekrar baştaki süz bilgilerine geri dönücek!!!

Değerli bilgilerinizi bizimle paylaştığınız için çok teşekkürederim.
Çok fazla bilgi sahibi değilim. Hatam olmuş ise afedersiniz!

Levent Menteşoğlu · 7 Kasım 2006

Bir örnek dosya ekleyebilirmisiniz.

shenko · 7 Kasım 2006

Örnek dosya ektedir!!

shenko · 7 Kasım 2006

Değerli üstad cevaplarınızı bekliyorum teşekkürler...

Levent Menteşoğlu · 7 Kasım 2006

Aşağıdaki kodu deneyin. Sadece A sütunundaki tek bir kritere göre çalışmaktadır.

Kod:

Sub Button5_Click()
Application.ScreenUpdating = False
filt = ActiveSheet.FilterMode
If filt = True Then
deg = ActiveSheet.AutoFilter.Filters.Item(1).Criteria1
ActiveSheet.ShowAllData
End If
Range("A3:d65536").Sort Key1:=Range("a3"), Key2:=Range("c3")
son = [a65536].End(3).Row
Cells(3, 1).Font.Name = "Arial Black"
For x = 3 To son - 1
If Cells(x, 1) <> Cells(x + 1, 1) Then Cells(x + 1, 1).Font.Name = "Arial Black"
Next
If filt = True Then [a2:d2].AutoFilter Field:=1, Criteria1:="" & deg
Application.ScreenUpdating = True
MsgBox "ALICILAR'A G&#214;RE SIRALANDI!"
End Sub

shenko · 8 Kasım 2006

Üstad Leventm,

Anladığım kadarıyla, verdiğiniz makro sadece satıcı kriteri için geçerli. Yani satıcı kriterini değiştirdiğimizde en baştaki satıcıyı "Arial Black" yapıyor. Peki şu şekilde değiştirebilirmiyiz; satıcılar kriterini değiştirdiğimizde, alıcılar kısmındaki verilerin başındakileri "Arial Black", alıcılar kriterini değiştirdiğimizde, satıcılar kısmındaki verilerin başındakileri "Arial Black" veya ürün kriterini değiştirdiğimizde yine alıcılar kısmındaki verilerin başındakileri "Arial Black" yapabilimiyiz?

Levent Menteşoğlu · 8 Kasım 2006

Süzme olmadan sizin kendi kodunuz ne yapıyorsa benim verdiğim kodda süzme varken aynı işlemi yapmaktadır. Son mesajınızdaki istediğinizi açıkçası ben anlayamadım. Tekerleme gibi yazmışsınız. Bu isteğinizi örnek bir dosya ile veya resimlerle tekrar ifade edermisiniz.

shenko · 8 Kasım 2006

İlgili doya ektedir. Her şeyden önce sabrınıza çok teşekkürederim. Saygılar!!!

Levent Menteşoğlu · 8 Kasım 2006

Şimdi sorunuz net anlaşıldı. Aşağıdaki kodu denermisiniz.

Kod:

Sub renklendir()
say = WorksheetFunction.Subtotal(3, [a3:a65536])
ReDim deg(say + 1)
deg(0) = 0
For a = 3 To [a65536].End(3).Row
If Cells(a, "a").Height > 0 Then
c = c + 1
deg(c) = Cells(a, "a")
If deg(c - 1) <> deg(c) Then Cells(a, "a").Font.Name = "Arial Black"
Else
Cells(a, "a").Font.Name = "Arial"
End If
Next
End Sub

shenko · 8 Kasım 2006

Değerli üstad,

Emekleriniz ve bizimle paylaştıklarınız için size çok çok teşekkür ederim.

Eğer mümkünse, makronun açıklamasını metin şeklinde kelimelerle anlatırmısınız.

Saygılar, İyi çalışmalar..

Levent Menteşoğlu · 8 Kasım 2006

Yukarıda verdiğim kod üzerinde biraz daha kafa yorunca daha kısa ve özellikle çok sayıda veri söz konusu ise çok daha hızlı çalışacak bir çözüm daha aklıma geldi. Bu çözümüde altta sunuyorum.

Kod:

Sub renklendir()
On Error Resume Next
For Each hucre In Range("a3:a" & [a65536].End(3).Row).SpecialCells(xlCellTypeVisible)
If Range(rng) <> hucre Then hucre.Font.Name = "Arial Black"
rng = hucre.Address
Next
End Sub

Not:Kodun çalışma mantığınıda ilk fırsatta izah edeceğim.

shenko · 8 Kasım 2006

Haklısın üstad, eskisine nazaran çok daha hızlı ve daha kısa. Elelrine, kollarına ve aklına sağlık.

Levent Menteşoğlu · 8 Kasım 2006

leventm' Alıntı:
Kod:

Sub renklendir() On Error Resume Next For Each hucre In Range("a3:a" & [a65536].End(3).Row).SpecialCells(xlCellTypeVisible) If Range(rng) <> hucre Then hucre.Font.Name = "Arial Black" rng = hucre.Address Next End Sub

Yukarıda yazdığım kodun hangi mantığa göre yazıldığını izah etmeye çalışayım.

Öncelikle konuyu ifade edersem, sayfa üzerinde süzme işlemi yapılmışken, sayfa görüntüsünde her veriden sadece bir tanesinin yazı fontunu "Arial Black" yapmaktır.

Burada sıkıntı süzme işleminde verilerin ardışık satır nosu ile gitmemesidir. Yani yazılacak kod bu ardışık gitmeyen hücreleri tıpkı ardışık gidiyormuş gibi kabul edip, her veriden sadece birinin fontunu değiştirmelidir. Yani mükerrer kayıtlardan sadece ilkinin fontu değiştirilecektir.

Bu sorunun tespitinin ardından aşağıdaki satır ile sadece kayıtlı görünen hücrelerin adresleri tespit edilmiştir. Bu kod control+G ile açılan "GİT" penceresindeki "sadece görünen hücreler" işleminin VBA daki karşılığıdır.

Kod:

Range("a3:a" & [a65536].End(3).Row).SpecialCells(xlCellTypeVisible)

Yukarıdaki satırda yer alan "[a65536].end(3).row" ifadeside seçilecek aralığın son satırını tespit etmektedir.

Yukarıdaki kodla tespit edilen hücreler aralığındaki her hücrenin değerini değerlendirmek için bir döngü kurmak gerekir. Bu döngüde aşağıdaki gibidir.

Kod:

For Each hucre In Range("a3:a" & [a65536].End(3).Row).SpecialCells(xlCellTypeVisible) . . Next

Bir sonraki işlem bir önceki hücre ile seçilen hücredeki değerin karşılaştırılmasıdır. Bu işlemide döngü içindeki aşağıdaki satırlar yapar. Bu kodda "hucre", seçilen hücreyi "Range(rng)" de bir önceki hücreyi ifade eder. Bir önceki hücrenin adresini ise "rng=hucre.address" ifadesi tespit etmektedir.

Kod:

If Range(rng) <> hucre Then hucre.Font.Name = "Arial Black" rng = hucre.Address

Son olarak kod içindeki "on error resume next" satırı ise bir hata olduğunda kodun işlemine devam etmesini sağlar. Kod içinde tek hata, sadece ilk hücrenin bir önceki ile değerlendirilmesin ortaya çıkacaktır. Çünkü ilk hücrenin bir önceki hücre adresi henüz belli değildir. Bu adres ancak ikinci hücreye geçildiğinde "rng=hucre.address" ifadesi ile tespit edilir.

Umarım yeterince anlaşılır şekilde izah edebilmişimdir.

shenko · 9 Kasım 2006

Elinize sağlık üstad. Söyliyecek kelime bulamıyorum. Teşekkürler!!!

Makro düzeltme!!! (Süzme işleminde font değiştirme)

shenko

Levent Menteşoğlu

Administrator

shenko

Levent Menteşoğlu

Administrator

shenko

shenko

Levent Menteşoğlu

Administrator

shenko

Levent Menteşoğlu

Administrator

shenko

Levent Menteşoğlu

Administrator

shenko

Levent Menteşoğlu

Administrator

shenko

Levent Menteşoğlu

Administrator

shenko

Makro d&#252;zeltme!!! (S&#252;zme i&#351;leminde font de&#287;i&#351;tirme)

Administrator

Administrator

Administrator

Administrator

Administrator

Administrator

Administrator

Makro düzeltme!!! (Süzme işleminde font değiştirme)