Hesap ekstresi açıklamasında yazılı komisyonları toplama

[muratergul963258]

Arkadaşlar banka hesap ekstresinde açıklamada kredi kartı komisyon tutarları yazıyor ve bunu toplayabilmem için bir formüle ihtiyacım var. Yardım edebilecek arkadaşlara şimdiden teşekkürler

not : ekstre dosyası aşağıdaki linktedir.

http://s3.dosya.tc/server7/zoumjb/ak.xls.html

 

[sametozyavuz]

listenize filtre uygulayın.
"metin filtreleri" bölümünden "içerir" kısmını seçin.
istediğiniz metni örneğin "komisyon" belirtin.
sadece o liste görülecektir.

 

[muratergul963258]

sisteme giriş yaparken ekstredeki açıklamayı tam olarak girmeliyim bu nedenle bu rakamları toplamam gerekiyor

 

[sametozyavuz]

aradığınız metin tam olarak nedir.

 

[muratergul963258]

konu ekinde dosya var açıklama kısmında ( " 000632759 YI-DB AKPOS PES ODE 20160111 KS:8.11TL " ) KS: 8.11TL gibi rakamlar bulunuyor. bunları toplatabilecek bir formül arıyorum

 

[sametozyavuz]

bu kodu deneyiniz.
en sonda metin olarak saklanan sayıları elle sayıya dönüştürmelisiniz.

Sub Makro4()
'
' Makro4 Makro
'

'
    Range("D1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$1000").AutoFilter Field:=4, Criteria1:="=*KS:*", _
        Operator:=xlAnd
    Range("A1:D1000").Select
    Range("D1").Activate
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Range("E2").Select
    Application.CutCopyMode = False
    Range("E2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(MID(RC[-1],SEARCH(""KS:"",RC[-1])+3,10)),"""",MID(RC[-1],SEARCH(""KS:"",RC[-1])+3,10))"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E57")
    Range("E2:E1000").Select
    Range("F2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(REPLACE(RC[-1],SEARCH(""TL"",RC[-1]),6,""""),"""")"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F57")
    Range("F2:F1000").Select
    Columns("F:F").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("B1").Select
End Sub

 

[sametozyavuz]

http://s3.dosya.tc/server7/ae5amh/ak.rar.html

 

[halilyor]

Dosyanız bu linkte.

http://s8.dosya.tc/server/i059aw/ak__1_.xls.html