Benzersiz Makrosunda Değişiklik

[1Al2Ver]

Merhaba,

Aşağıdaki kod'da ;

a = S1.Range("B8:F56").Value aralığını,

B8:F16
B18:F26
B28:F36
B38:F46
B48:F56 şeklinde sıralamak istiyorum,

Teşekkür ederim.

Sub DİKİNE()
Set S1 = Sheets("DİKİNE")
Application.ScreenUpdating = False
    Set dict = CreateObject("Scripting.Dictionary")
    S1.Range("H2:H" & [H2].End(xlDown).Row).ClearContents
    a = S1.Range("B8:F56").Value
        For Each b In a
        If b <> "" Then
            dict(b) = ""
        End If
        Next b
    S1.[H2].Resize(dict.Count, 1) = Application.Transpose(dict.keys)
Application.ScreenUpdating = True
End Sub

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Sub DİKİNE()
Set S1 = Sheets("DİKİNE")
alanlar = Array(S1.Range("B8:F16"), S1.Range("B18:F26"), S1.Range("B28:F36"), S1.Range("B38:F46"), S1.Range("B48:F56"))
Application.ScreenUpdating = False
Set dict = CreateObject("Scripting.Dictionary")
S1.Range("H2:H" & [H2].End(xlDown).Row).ClearContents
For Each alan In alanlar
    a = alan.Value
    For Each b In a
        If b <> "" Then
            dict(b) = ""
        End If
    Next b
Next
S1.[H2].Resize(dict.Count, 1) = Application.Transpose(dict.keys)
Application.ScreenUpdating = True
End Sub

 

[1Al2Ver]

Sayın ÖmerBey, merhaba,

Öncelikle, çözüm ve ilginiz için teşekkür ederim, sağ olun.

Öğrenmek adına ,

Sıralama yaparken sıfır olanları hariç tutmak istesem, kodda nasıl bir değişiklik yapmam gerekir ?

Teşekkür ederim.

 

[ÖmerBey]

İf sorgusunu şu şekilde değiştiriniz: If b <> "" And b <> 0 Then

 

[1Al2Ver]

Sayın ÖmerBey, tekrar merhaba,

Çok çok teşekkür ederim, sağ olun.

Saygılarımla.

 

[ÖmerBey]

Rica ederim, siz de sağ olun,
İyi çalışmalar...