Biçime göre toplam alma

[aydogankemal]

merhabalar,
elimde bir dosya var ve sütunlarda €, $, tl cinsinden rakamlar var
en alt satıra (yada uygun bir hücreye) €, $ ve TL toplamlarını nasıl alabilirim

 

[Ömer]

merhabalar,
elimde bir dosya var ve sütunlarda €, $, tl cinsinden rakamlar var
en alt satıra (yada uygun bir hücreye) €, $ ve TL toplamlarını nasıl alabilirim

Merhaba,

Linki inceleyiniz..

http://www.excel.web.tr/f50/para-birimindekileri-formata-gore-toplama-t30250.html

.

 

[aydogankemal]

sayın espiyonajl,
yardımınız için teşekkür ederim, verdiğiniz linkteki dosya € ve $ ı topluyor ama tl yi toplamıyor,
yardımcı olabilir misiniz

 

[Ömer]

sayın espiyonajl,
yardımınız için teşekkür ederim, verdiğiniz linkteki dosya € ve $ ı topluyor ama tl yi toplamıyor,
yardımcı olabilir misiniz

Modüle1 Sayfasındaki aşağıdaki kırmızı ile işaretli yerleri siliniz yani YTL olarak tanımlanan fonksiyonu TL olarak tanımlayınız..

Daha sonra dosyada D12 hücresindeki formüldeki kırmızı ile işaretli yeri siliniz..

=TOPLAYTL(B2:B11) yani formülü..

Public Function TOPLA[COLOR=red][B]Y[/B][/COLOR]TL( _
        ParamArray vInput() As Variant) As Variant
    Dim rParam As Variant
    Dim rCell As Range
    Dim vTemp As Variant
        
    Application.Volatile
    On Error GoTo Hata
    For Each rParam In vInput
      If TypeName(rParam) = "Range" Then
         With rParam
           For Each rCell In Intersect( _
               .Cells, .Cells.Parent.UsedRange)
             With rCell
               If .NumberFormat = "#,##0.00 $" Then
                 If IsError(.Value) Then
                    vTemp = .Value
                    Exit For
                  ElseIf VarType(.Value2) = vbDouble Then
                    vTemp = vTemp + .Value2
                  End If
               End If
             End With
           Next rCell
         End With
       End If
     Next rParam
     TOPLA[COLOR=red][B]Y[/B][/COLOR]TL = vTemp
Devam:
     On Error GoTo 0
     Exit Function
Hata:
     If Err.Number = 6 Then TOPLA[COLOR=red][B]Y[/B][/COLOR]TL = CVErr(xlErrNum)
     Resume Devam
   End Function