Verileri diğer sayfalara aktarılması

1903emre34@gmail.com

Altın Üye
Katılım
29 Mayıs 2016
Mesajlar
906
Excel Vers. ve Dili
Microsoft Excel 2013 Türkçe
Altın Üyelik Bitiş Tarihi
06-06-2027
Merhaba,

Ekteki dosyada, "A" sütünda yer alan en sağdaki kalın boyanmış tutarlarından öncekileri diğer sütüna aktarılması için kodl oluşturabilir miyiz
 

Ekli dosyalar

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,646
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()
    Dim i
    Range("B5:B" & Rows.Count).ClearContents
    For i = 5 To Cells(Rows.Count, 1).End(3).Row
        Cells(i, 2).Value = Trim(StrReverse(Split(StrReverse(Trim(Cells(i, 1).Value)), " ", 2)(1)))
    Next i
End Sub
Kod:
Sub test2()
    Dim i, al, m
    Range("B5:E" & Rows.Count).ClearContents
    With CreateObject("VBScript.Regexp")
        .Pattern = "^(.+)\s([\d\.\,\-]+)\s([\d\.\,]+)\s([\d\.\,]+)(\s$)"
        For i = 5 To Cells(Rows.Count, 1).End(3).Row
            al = Cells(i, 1).Value
            Set m = .Execute(al)
            Cells(i, 2).Value = m(0).submatches(0)
            Cells(i, 3).Value = CDbl(m(0).submatches(1))
            Cells(i, 4).Value = CDbl(m(0).submatches(2))
            Cells(i, 5).Value = CDbl(m(0).submatches(3))
        Next i
    End With
End Sub
 

1903emre34@gmail.com

Altın Üye
Katılım
29 Mayıs 2016
Mesajlar
906
Excel Vers. ve Dili
Microsoft Excel 2013 Türkçe
Altın Üyelik Bitiş Tarihi
06-06-2027
İlginiz için teşekkürler, ilk kod işe yaradı.
 
Üst