Soru Ayrı sütundakileri aynı verileri sıralama

[NADİR YILDIZ]

Arkadaşlar merhaba
Ayrı sütundakileri aynı verileri sıralamak istiyorum
Orjinal listede aynı fatura numarası olanları karşılıklı olarak sıralatmak istiyorum
olmasını istediğimi listede örnek olarak yaptım.
orjinal listenin olduğu yerde sıralatmak istiyorum
B sütunundaki tarih sırasına göre sıralatmanızı rica ediyorum

iyi çalışmalar

 

[NADİR YILDIZ]

Soru - Karşılıklı sıralama

Arkadaşlar yapmak istediğimi çalışmam üzerinde açıkladım. yardımcı olacak üstadlara şimdiden teşekkür ediyorum iyi çalışmalar

www.excel.web.tr

Daha önce başka bir çalışmamda sayın muygunun kodlarını buraya uygulamak istedim ancak başaralı olamadım

 

[NADİR YILDIZ]

Arkadaşlar bu konuda yardımcı olabilecek misiniz ?

 

[NADİR YILDIZ]

Bu konuda ücretli destek verecek kimse varmı

 

[muygun]

Merhaba;
Sorunuz net değil.
Hangi tablolar hangi tablolara bakarak hangi kritere göre nerede düzenlenecek?
Bir sayfada 6 tip tablo var
Hepsini açıklamanız gerekiyor ki çözüm üretebilelim.
İyi çalışmalar.

 

[NADİR YILDIZ]

Sayın muygun öncelikle cevap verdiğiniz için teşekkür ederim.

Sarı alandaki C sütunundaki Fatura numaralarının karşısına mavi alanda K sütunundaki fatura numarası aynı olanların karşılıklı olarak sıralatmak istiyorum.
satır 6 yeşil olanın karşısına satır 16 daki yeşil satırın gelmesi gibi

teşekkürler

 

[veyselemre]

Sub test()
    Dim veri, i&, rng As Range, lR&, itm, mx&
    With CreateObject("Scripting.Dictionary")

        veri = Range("C6:C" & Cells(Rows.Count, 3).End(3).Row).Value

        For i = 1 To UBound(veri)
            .Item(veri(i, 1)) = i
        Next i
        mx = i

        lR = Cells(Rows.Count, "K").End(3).Row
        Set rng = Range("I6:I" & lR)
        veri = Range("K6:K" & lR).Value

        For i = 1 To UBound(veri)
            If .exists(veri(i, 1)) Then
                rng(i) = .Item(veri(i, 1))
                .Remove veri(i, 1)
            Else
                rng(i) = mx
                mx = mx + 1
            End If
        Next i

        If .Count > 0 Then
            lR = rng.Rows.Count
            Set rng = rng.Resize(lR + .Count)
            For Each itm In .items
                lR = lR + 1
                rng(lR) = itm
            Next itm
        End If

        rng.Resize(, 7).Sort rng(1), , , , , , , xlNo
        rng.ClearContents
    End With
End Sub

 

[NADİR YILDIZ]

Veysel bey teşekkürler
aklınıza emeğinize sağlık
hakkınızı helal edin
iyi çalışmalar