Yıllara göre verileri yandaki sütünlara aktarılması

[1903emre34@gmail.com]

Merhaba,

"A" sütündaki hesap planındaki yanındaki rakamlar (sırasıyla) 2015 ve 2016 yıllarını göstermektedir. Benim istediğim, ilki 2015 ve 2016, "B" ve " "C" aktarmak, ve yaptığı zaman "A" sütndaki noktaları ve rakamları yer değiştirecek şekilde nasıl kod oluşturabiliriz (Manuel olarak b3ve c3 hücresinde yapılmıştır)

 

[Ziynettin]

Merhaba,

Verileriniz aynı yapıda ise istediğiniz sonuca ulaşırsınız.

Sub ayir()
On Error Resume Next
a = Range("A3:A" & Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 2)
    For i = 1 To UBound(a)
        deg = Split(a(i, 1), " ")
        say = say + 1
            For y = 1 To UBound(deg)
                b(say, 1) = deg(y - 1)
                b(say, 2) = deg(y)
            Next y
    Next i
tbl = Array(b)
ReDim c(1 To UBound(a), 1 To 2)
    For i = 1 To UBound(a)
        c(i, 1) = tbl(0)(i, 1) * 1
        c(i, 2) = tbl(0)(i, 2) * 1
    Next i
Range("B3:C" & Rows.Count).ClearContents
[B3].Resize(say, 2) = c
[B3].Resize(say, 2).NumberFormat = "#,##0.00"
MsgBox "İşlem tamam...", vbInformation
End Sub

 

[1903emre34@gmail.com]

Teşekkürler,

Sizden iki hususta isteğim olacak,

I. Dönen Varlıklar 25.892.417,21 33.077.355,97, diğer yandaki sütünlara aktarırken A'daki verilerin rakamsız olması yani, I. Dönen Varlıklar gibi,

Rakamlar diğer yanda olduğu zaman, noktaların ve virgüllerin yer değiştirmesi

Örneğin, 25,892,417.21 33,077,355.97

 

[Ziynettin]

Teşekkürler,

Sizden iki hususta isteğim olacak,

I. Dönen Varlıklar 25.892.417,21 33.077.355,97, diğer yandaki sütünlara aktarırken A'daki verilerin rakamsız olması yani, I. Dönen Varlıklar gibi,

Rakamlar diğer yanda olduğu zaman, noktaların ve virgüllerin yer değiştirmesi

Örneğin, 25,892,417.21 33,077,355.97

Sub deneme()
On Error Resume Next
a = Range("A3:A" & Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 3)
    For i = 1 To UBound(a)
        deg = Split(a(i, 1), " ")
        say = say + 1
            For y = 1 To UBound(deg)
                For x = 0 To UBound(deg) - 2
                    deg1 = deg1 & " " & deg(x)
                    b(say, 1) = deg1
                Next x
                deg1 = ""
                b(say, 2) = Replace(deg(y - 1), ",", "|")
                b(say, 3) = Replace(deg(y), ",", "|")
            Next y
    Next i
tbl = Array(b)
ReDim c(1 To UBound(a), 1 To 3)
    For i = 1 To UBound(a)
        c(i, 1) = tbl(0)(i, 1)
        c(i, 2) = Replace(Replace(tbl(0)(i, 2), ".", ","), "|", ".")
        c(i, 3) = Replace(Replace(tbl(0)(i, 3), ".", ","), "|", ".")
    Next i
Range("B3:D" & Rows.Count).ClearContents
[C3].Resize(say, 2).NumberFormat = "@"
[B3].Resize(say, 3) = c
MsgBox "İşlem tamam...", vbInformation
End Sub

 

[1903emre34@gmail.com]

Tekrar sağ olun,

İyi çalışmalar