EURO ve USD satırlarını sütuna yazdırma

[denizaslan]

merhabalar;

ekte ki tabloda; A sütununda EUR yazanları E sütunundaki EURO sütununa yazdırmam A sütununda USD yazanlarıda F sütunundaki USD sütununa yazdırmam gerekiyor daha sonra da EUR ve USD yazan satırların silinmesini istiyorum bu şekilde bir formül üretebilir miyiz.

Teşekkürler.

 

[denizaslan]

pardon düzeltiyorum ;

A sütununda EUR yazanları TL satırının karşısına USD yazanlarıda aynı firmanın TL karşısına yazmamız gerekiyor
Yani ben listeye bakınca ABCDE firmasının TL - EUR - USD aynı satırda görmek istiyorum;
Boşa çıkan satırın silinmesi işlemini süzerek yaparız.

Bu şekilde yardımcı olabilir misiniz.
Teşekkürler.

 

[denizaslan]

maalesef hala çözüm bulamadım

 

[Orion1]

Dosyanız ektedir.
Önce dosyanın yedeğini alın.

Sub para_birimi()
Dim sat As Long, i As Long, para As Double
Sheets("GENEL").Select
Range("A1").AutoFilter
Application.ScreenUpdating = False
sat = Cells(65536, "A").End(xlUp).Row
For i = 2 To sat
    If Cells(i, "A").Value = "TL" Then
        para = Cells(i, "D").Value
        Range("D" & i & ":F" & i).ClearContents
        Cells(i, "D").Value = para
    End If
    If Cells(i, "A").Value = "EUR" Then
        para = Cells(i, "D").Value
        Range("D" & i & ":F" & i).ClearContents
        Cells(i, "E").Value = para
    End If
    If Cells(i, "A").Value = "USD" Then
        para = Cells(i, "D").Value
        Range("D" & i & ":F" & i).ClearContents
        Cells(i, "F").Value = para
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[denizaslan]

Evren Bey; çok teşekkür ederim çalışmanız için.

birşey daha sorcam
aynı satıra yazdırma şansım var mı acaba

Örnek: Şirket EUR TL
ERGİN DİZEL OTOMOTİV NAKLİYAT TİC. VE AN.LTD.ŞTİ. xxxx xxx

gibi mesela.

 

[Orion1]

Evren Bey; çok teşekkür ederim çalışmanız için.

birşey daha sorcam
aynı satıra yazdırma şansım var mı acaba

Örnek: Şirket EUR TL
ERGİN DİZEL OTOMOTİV NAKLİYAT TİC. VE AN.LTD.ŞTİ. xxxx xxx

gibi mesela.

Ne dediğiniz anlamadım.
Zaten hangi para birimi ise o parabirimi sütununa o satır yazılıyor miktarlar.
Başka satıra yazılmıyor.

 

[denizaslan]

şöyle anlatayım ben hepsinin TEK bir satırda tutacağım

şu andaki listede ;

x firması 25 TL
x firması 35 EUR

bu şekilde ben bunları tek satıra alacağım ve liste sonuçta
x firması 25 TL 35 EUR aynı satıra gelecek ve fazla kalan satırı sileceğim.

yani ayın firma isminde tek bir adet olacak listemde TL USD Eur aynı satıra taşınacak.

 

[Orion1]

şöyle anlatayım ben hepsinin TEK bir satırda tutacağım

şu andaki listede ;

x firması 25 TL
x firması 35 EUR

bu şekilde ben bunları tek satıra alacağım ve liste sonuçta
x firması 25 TL 35 EUR aynı satıra gelecek ve fazla kalan satırı sileceğim.

yani ayın firma isminde tek bir adet olacak listemde TL USD Eur aynı satıra taşınacak.

Sub para_birimi()
Dim sat As Long, i As Long
Dim myarr(), n As Long, z As Object
Sheets("GENEL").Select
Range("A1").AutoFilter
Application.ScreenUpdating = False
sat = Cells(65536, "B").End(xlUp).Row
ReDim myarr(1 To 5, 1 To sat)
Set z = CreateObject("Scripting.Dictionary")
For i = 2 To sat
    If Not z.exists(Cells(i, "B").Value) Then
        n = n + 1
        z.Add Cells(i, "B").Value, n
    End If
    myarr(1, z.Item(Cells(i, "B").Value)) = Cells(i, "B").Value
    myarr(2, z.Item(Cells(i, "B").Value)) = Cells(i, "C").Value
    If Cells(i, "A").Value = "TL" Then
        myarr(3, z.Item(Cells(i, "B").Value)) = myarr(3, z.Item(Cells(i, "B").Value)) _
        + Cells(i, "D").Value
    End If
    If Cells(i, "A").Value = "EUR" Then
        myarr(4, z.Item(Cells(i, "B").Value)) = myarr(4, z.Item(Cells(i, "B").Value)) _
        + Cells(i, "D").Value
    End If
    If Cells(i, "A").Value = "USD" Then
        myarr(5, z.Item(Cells(i, "B").Value)) = myarr(5, z.Item(Cells(i, "B").Value)) _
        + Cells(i, "D").Value
    End If
Next
Range("A2:F65536").ClearContents
If n > 0 Then
    Range("B2").Resize(n, 5) = Application.Transpose(myarr)
End If
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[denizaslan]

Evren Hocam harikasınız tek kelimeyle, ellerine sağlık çok teşekkür ederim.

 

[Orion1]

Evren Hocam harikasınız tek kelimeyle, ellerine sağlık çok teşekkür ederim.

Rica ederim.
O sizin harikalığınız.