Yanyana kolonlardaki numaraları, başka bir kolonda sıralama

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Bitişik kolondaki bilgileri ard arda sıralama konusunda bir örnek ekledim. Fonksiyonla çözdüm ama mümkünse makro ile çözmek istiyorum. Duruma göre her sütunda 250 civarında numara olabiliyor. Benzersiz sıralama var.
Saygılarımla

 

[Ömer BARAN]

Merhabalar.

Yanlış anlamadıysam; aşağıdaki kod'u kullanabilirsiniz.
.

Sub SÜTUNDA_LİSTELE_BRN()
Range("O8:O" & [O65536].End(3).Row).ClearContents
For sut = 9 To 13
    For sat = 8 To Cells(65536, sut).End(3).Row
        If Cells(8, 15) = "" Then
            satır = 8
        Else
            satır = [O65536].End(3).Row + 1
        End If
    Cells(satır, 15) = Cells(sat, sut)
    Next
Next: MsgBox "LİSTELEME BİTTİ"
End Sub

 

[Ziynettin]

Merhaba,

Aşağıdaki kodu deneyiniz.

Sub Benzersiz_Liste()
Dim a(), b(), d As Object
Dim X, Y, Son As Integer, Say As Integer
    Set d = CreateObject("Scripting.Dictionary")
    Son = Range("I:M").Find("*", , , , xlByRows, xlPrevious).Row
    If Son < 8 Then MsgBox "Tablonuz Boş Liste Yapılamıyor.", vbCritical: Exit Sub
    a = Range("I8:M25")
    For Each X In a
        If X <> "" Then d(X) = ""
    Next X
    
    ReDim b(1 To d.Count, 1 To 1)
    Say = 1
    For Each Y In d.keys
        b(Say, 1) = Y
        Say = Say + 1
    Next Y
    Range("O8:O" & Rows.Count).ClearContents
    If Say > 0 Then
        [O8].Resize(d.Count) = b
        [O8].Resize(d.Count).Sort Key1:=[O8], order1:=xlAscending
    End If
MsgBox "İşleminiz Tamam.", vbInformation
End Sub

 

[Tevfik_Kursun]

Sayın Arkadaşlar,
İlgilerinize çok teşekkür ederim.
Saygılarımla