tekrar eden olursa sağa yukarı ötelemek

[spasmex97]

Günaydınlar arkadaşlar, elimdeki veriyi hızlıca düzenlemek için bir yöntem oluşturmaya çalışıyorum, matematiksel olarak çözdüm sanırım fakat kod olarak bilmiyorum, alt alta gelebilen şu şekilde verilerim olabiliyor
47652499_ASM\14078000.stp
47652499_ASM\47652452.stp
47652499_ASM\47652453.stp
bu verilerin tekrar sayıları artabiliyor, farkındaysanız "\" dan önceki metin birebir aynıyken "\" den sonraki metin değişebiliyor yaptırmak istediğim şeyse şu;
tekrar edenleri sayıp bir x sayısı tutsun, tekrar sayısı arttıkça offset(1-x,x-1) yapsın, yani "1" bir adet tekrar varsa, "\" dan önceki metin toplam 2 kez göründüyse 2. yi bir yukarı bir sağa (-1,1) eğer tekrar sayısı 3 ise (-2,2) şeklinde hücre içerisindeki veriyi kopyalamasını istiyorum

47652499_ASM\14078000.stp
47652499_ASM\47652452.stp
47652499_ASM\47652453.stp
olan veriyi
sütunlara ayırmak istiyorum
47652499_ASM\14078000.stp - 47652452.stp - 47652453.stp
şeklinde


sanırım eksik bir tanımlama yapmışım, tekrar sayılarını sayarak sadece son hücrenin diyagoneline veri kopyalaması yaptırabiliyorum, önce (1,1) hücresindeki veriyi (2,1) hücresindeki veriyle karşılaştırmalı, eğer eşleşme varsa (2,1) hücresindeki veriyi (1,2) ye atmalı, (1,1) hücresinin verisini baz almaya devam ederek eşleşme aramalı ( eşleşmeler alt alta olacaktır) eğer (3,1) de eşleşme varsa (1,3) e atmalı, (1,1) hücresindeki veriyi devam eden hücredeki veriyle karşılaştrmalı eğer artık daha fazla eşleşme yoksa yeni gelen veriyi baz alarak aynı döngüyü devam ettirmeli
örnek dosya
örnek.xlsx - 10 KB

 

[spasmex97]

Düzenledim biraz daha tam anlamadığınız yeri belirtirseniz, daha uzunca açıklayabilirim

 

[ÖmerFaruk]

10-15 satırdan oluşan örnek veriyi ve istediğiniz çözümü manuel olarak (doğru şekilde) gösterdiğiniz örnek dosyayı harici paylaşım sitesine yükler ve link paylaşırsanız hızlıca cevap alabileceğinize eminim.

 

[spasmex97]

10-15 satırdan oluşan örnek veriyi ve istediğiniz çözümü manuel olarak (doğru şekilde) gösterdiğiniz örnek dosyayı harici paylaşım sitesine yükler ve link paylaşırsanız hızlıca cevap alabileceğinize eminim.

ekledim

 

[ÖmerFaruk]

Olmasını istediğim isimli sayfanızda
A sütununda 1-6 satırları ile 7-8 satırları arasında fark var. Hangisi doğru?

 

[spasmex97]

Olmasını istediğim isimli sayfanızda
A sütununda 1-6 satırları ile 7-8 satırları arasında fark var. Hangisi doğru?

orada sadece "\" dan sonraki kısmı yazmayı unutmuşum, önemli olan zaten "\" solunda kalan kısım, gruplanmış transpoze olmuş şekilde yazıyorlar sadece

 

[veyselemre]

Sub test()
    Dim veri, w(1 To 2), i%, bol, ky$, s2 As Worksheet, sat%, y
    With Sheets("ilk hali")
        veri = .Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    Set s2 = Sheets("olmasını istediğim")
    With CreateObject("Scripting.Dictionary")
        s2.Cells.ClearContents
        For i = 1 To UBound(veri)
            bol = Split(veri(i, 1), "\")
            ky = bol(0)
            If Not .exists(ky) Then
                sat = sat + 1
                w(1) = sat
                w(2) = 2
                .Item(ky) = w
                's2.Cells(sat, 1).Value = veri(i, 1)
                s2.Cells(sat, 1).Value = ky
                s2.Cells(sat, 2).Value = bol(1)
            Else
                y = .Item(ky)
                y(2) = y(2) + 1
                .Item(ky) = y
                s2.Cells(y(1), y(2)).Value = bol(1)
            End If
        Next i
    End With
End Sub

 

[spasmex97]

Sub test()
    Dim veri, w(1 To 2), i%, bol, ky$, s2 As Worksheet, sat%, y
    With Sheets("ilk hali")
        veri = .Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    Set s2 = Sheets("olmasını istediğim")
    With CreateObject("Scripting.Dictionary")
        s2.Cells.ClearContents
        For i = 1 To UBound(veri)
            bol = Split(veri(i, 1), "\")
            ky = bol(0)
            If Not .exists(ky) Then
                sat = sat + 1
                w(1) = sat
                w(2) = 2
                .Item(ky) = w
                's2.Cells(sat, 1).Value = veri(i, 1)
                s2.Cells(sat, 1).Value = ky
                s2.Cells(sat, 2).Value = bol(1)
            Else
                y = .Item(ky)
                y(2) = y(2) + 1
                .Item(ky) = y
                s2.Cells(y(1), y(2)).Value = bol(1)
            End If
        Next i
    End With
End Sub

şimdi görme fırsatım oldu, tam istediğim şekilde çalışıyor, Ubound tam olarak ne işe yarıyor