Tutarları aktarılması hk.

[1903emre34@gmail.com]

Merhaba,


A sütündaki tutarların (siyah punto ) yandaki kısma aktarılmas için nasıl kod oluşturabiliriz

 

[Asri]

Aşağıdaki şekilde deneyiniz.
Tutardan önce boşluk olmak zorunda.
Satırda boşluk yok ise TUTAR YOK hatası yazar.

Sub tutarayir()
'Asri Akdeniz - www.asriakdeniz.com - asriakdeniz@gmail.com
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  For i = 1 To sonsatir
     gec = StrReverse(Cells(i, "A").Value)
     If InStr(gec, " ") > 0 Then
        Cells(i, "B").Value = StrReverse(Left(gec, InStr(gec, " ")))
     Else
        Cells(i, "B").Value = "TUTAR YOK"
     End If
  Next i
End Sub

 

[1903emre34@gmail.com]

İlginiz içi teşekkürler, bir kısım açıklamayı unutmuşum, ekteki dosya bakabilir misiniz

 

[Asri]

İlginiz içi teşekkürler, bir kısım açıklamayı unutmuşum, ekteki dosya bakabilir misiniz

Siz AAA olarak yazmışsınız ancak sanırım anlamlı cümleler var.
Bu şekilde alınması zor. Örnek verilerinizi gerçek verilere benzer şekilde yazabilir misiniz?

 

[1903emre34@gmail.com]

Dosya ektedir.

 

[Asri]

Çok iyi bir ayırma beklemek ile beraber iş görecektir.

Const harfler As String = "ABCDEFGĞHIİJKLMNOÖPRSŞTUÜXWVYZ. "
Sub menu()
    'Asri Akdeniz - www.asriakdeniz.com - asriakdeniz@gmail.com   
    Call tutarayir
    Call aciklamaayir
End Sub

Sub tutarayir()
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  For i = 1 To sonsatir
     gec = StrReverse(Cells(i, "A").Value)
     If InStr(gec, " ") > 0 Then
        Cells(i, "B").Value = StrReverse(Left(gec, InStr(gec, " ")))
     Else
        Cells(i, "B").Value = "TUTAR YOK"
     End If
  Next i
End Sub

Sub aciklamaayir()
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  For i = 1 To sonsatir
     gec = Replace(temizle(Cells(i, "A").Value), " .", "")
     Cells(i, "C").Value = Trim(gec)
  Next i
End Sub

Public Function temizle(cumle)
   gecici = ""
   For j = 1 To Len(cumle)
     h = Mid(cumle, j, 1)
     If InStr(harfler, h) > 0 Then
        gecici = gecici + h
     End If
   Next j
  temizle = gecici
End Function