sayı formatında kuruş hesabı nokta virgül karmaşası

[meleklerim]

Öncelikle herkese merhaba
1) Tutar girdiğim bir textbox ta kuruş girmek için . (nokta) kullanmak zorunda kalıyorum.
Örneğin 25,12 gireceksem 25.12 giriyorum. Excel tablosuna 25,12 olarak yansıyor. (Nokta ile giriyorum virgül olarak gösteriyor)
Hesaplamada bir sıkıntı görünmüyor. Ancak aynı satırı çağırıp güncelleme yaparken tutar textbox ta VİRGÜLLÜ FORMATINDA GÖRÜNTÜLENDİĞİ için
yeniden aynı sayıyı noktalı formatında girmek zorunda kalıyorum unutursam ya da girmezsem tutarlar değişiyor.

isteğim
Yazdığım tutarın varsa ondalık sayısını virgülle gireyim virgülle göstersin
Girdiğim tüm tutarları virgülden sonra iki basamak göstersin. (145,20 / 162,00 gibi)
Binlik ayrac kullansın (1.652,00 / 125.465,23 gibi)

Tutarların bu şekil girilmesi ve gösterilmesi için tutartextbox a kayıt sırasında nasıl bir format yazmalıyım?

2) çalışma kitabımdaki defhaz adındaki sayfanın B sütununa B2 den başlayarak E SÜTUNUNDAKİ DOLU SATIR KADAR =eğer(e2>0;"satırsay()-1;"" formülünü nasıl yazdırabilirim.

 

[f4tih]

1. sorun için

Private Sub TutarTextBox_Change()
    Dim txt As String
    Dim formattedValue As String

    ' TextBox değerini alalım
    txt = TutarTextBox.Text

    ' Noktayı virgüle çevir
    txt = Replace(txt, ".", ",")

    ' Girilen değeri kontrol eder
    If IsNumeric(txt) Then
        ' Sayıyı iki ondalık basamak ve binlik ayraç formatında biçimlendir.
        formattedValue = Format(CDbl(txt), "#,##0.00")
        TutarTextBox.Text = formattedValue

        TutarTextBox.SelStart = Len(TutarTextBox.Text)
    End If
End Sub

bu kod ile kendinize göre uyarlayıp dener misiniz.


2. soru için bu işlemi bir formül ile mi uygulamak istiyorsunuz? yani daha doğrusu vba ile mi yapacak.

vba ile

Sub FormulYazdir()

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' "defhaz" adlı sayfayı seç
    Set ws = ThisWorkbook.Sheets("defhaz")

    ' E sütunundaki son dolu satırı say
    lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row

    ' B sütununa formülü yaz
    For i = 2 To lastRow
        ws.Cells(i, "B").FormulaLocal = "=EĞER(E" & i & ">0;SATIRSAY()-1;"""")"
    Next i

End Sub

böyle bir kod önerebilirim tabi ben kod ile anladığım için öyle yaptım. sorunu çözemezsek eğer dosya paylaşmanızı rica ederim o zaman daha kolay ve doğru çözüm sunulur forumda. İyi günler.

 

[meleklerim]

2. makroyu uyarladım çalışıyor. çok teşekkür ederim.
1. makro da tutar giremiyorum. Daha ilk sayı girmemde hemen ondalık atıyor. Örneğin 4500 gireceğim, daha 4 yazar yazmaz 4,00 yapıyor. backspace tuşu bile çalışmıyor. Neden olabilir ki. Change tetiklemesi yüzünden sanki.
Bir de tüm girişleri metne çeviriyor. "Metin olarak saklanan sayı" uyarısı veriyor veritabanında.

 

[f4tih]

örnek dosya paylaşma durumunuz olursa daha kolay çözeriz sanki

 

[meleklerim]

örnek dosya malesef bitmiş değil. çorba gibi. yine de teşekkür ederim. change yerine exit tetiklemesini yaptım. ama metin olarak saklanan sayı olayı devam ediyor.

 

[RBozkurt]

Ayarlardan değiştirseniz?

 

[meleklerim]

zaten öyle hocam. Metin olarak saklanan sayıların otomatik olarak "sayı" olarak sayılması için bir çözüm arıyorum.

 

[Biolightant]

Merhaba,
Doğru anladıysam bunun gibi bişi istiyorsunuz.

TextBox ismi TextBoxTL maksimum değer 999.999.999,99 daha fazla istenirse geliştirilmesi gerek.
Post makinelerinde olduğu gibi rakamlar tek tek girilmeli ( en sonda ki *,00 da dahil biraz sıkıcı ).

Private Sub UserForm_Initialize()
    TextBoxTL.TextAlign = fmTextAlignRight
End Sub

Private Sub TextBoxTL_Change()
Dim a
a = Replace(TextBoxTL, ",", "")
a = Replace(a, ".", "")

 If IsNumeric(a) = False Then
  TextBoxTL.Value = "0,00"
 ElseIf a < 10 Then
  TextBoxTL = "0,0" & a * 1
 ElseIf a < 100 Then
  TextBoxTL = "0," & a * 1
 ElseIf a < 1000 Then
    
    If Mid(a, 1, 1) = 0 Then
     TextBoxTL = Mid(a, 2, 1) & "," & Right(a, 2)
    End If
    
    If Mid(Right(TextBoxTL, 2), 1, 1) = "," Then
     TextBoxTL = Mid(a, 1, 1) & "," & Right(a, 2)
    End If
  
    If TextBoxTL.Value Like "*,*" = False Then
     TextBoxTL = Mid(a, 1, 1) & "," & Right(a, 2)
    End If
  
 ElseIf a < 10000 Then
  TextBoxTL = Mid(a, 1, 2) & "," & Right(a, 2)
 ElseIf a < 100000 Then
  TextBoxTL = Mid(a, 1, 3) & "," & Right(a, 2)
 ElseIf a < 1000000 Then
  TextBoxTL = Mid(a, 1, 1) & "." & Mid(a, 2, 3) & "," & Right(a, 2)
 ElseIf a < 10000000 Then
  TextBoxTL = Mid(a, 1, 2) & "." & Mid(a, 3, 3) & "," & Right(a, 2)
 ElseIf a < 100000000 Then
  TextBoxTL = Mid(a, 1, 3) & "." & Mid(a, 4, 3) & "," & Right(a, 2)
 ElseIf a < 1000000000 Then
  TextBoxTL = Mid(a, 1, 1) & "." & Mid(a, 2, 3) & "." & Mid(a, 5, 3) & "," & Right(a, 2)
 ElseIf a < 10000000000# Then
  TextBoxTL = Mid(a, 1, 2) & "." & Mid(a, 3, 3) & "." & Mid(a, 6, 3) & "," & Right(a, 2)
 Else
  TextBoxTL = Mid(a, 1, 3) & "." & Mid(a, 4, 3) & "." & Mid(a, 7, 3) & "," & Right(a, 2)
 End If

End Sub

Private Sub TextBoxTL_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
        KeyAscii = 0
        Beep
    End If
End Sub

 

[meleklerim]

hocam malesef olmadı. hem de sayı girmek bir işkenceye dönüştü 456 yazıyorum 4,56 algılıyor. teşekkür ederim yine de

 

[meleklerim]

Sub sayıyaçevir()
Dim i As Long
i = Cells(65536, "B").End(xlUp).Row
Range("G1").Copy
Range("B2:B" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("G1").Select
End Sub

bu kodda G1 e 1 yazmama rağmen 1 ile çarpmıyor. Aslında metin gibi görünen sayıları 1 ile çarpmak onları sayıya dönüştürüyormuş ama bu kodda ne eksik ki?

 

[Biolightant]

456 yazıyorum 4,56 algılıyor

Post makinelerinde olduğu gibi rakamlar tek tek girilmeli ( en sonda ki *,00 da dahil biraz sıkıcı ).

 

[pitchoute]

Merhaba çözüm ve alternatif olması adına paylaşıyorum;

Private Sub TutarTextBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim girilenDeger As String
    Dim tutar As Double
    girilenDeger = Me.TutarTextBox.Text
    girilenDeger = Replace(girilenDeger, ".", "")
    girilenDeger = Replace(girilenDeger, ",", ".")
    If IsNumeric(girilenDeger) Then
        tutar = CDbl(girilenDeger)
        Me.TutarTextBox.Text = Format(tutar, "#,##0.00")
        Me.TutarTextBox.Text = Replace(Me.TutarTextBox.Text, ".", ",")
    Else
        MsgBox "Geçersiz sayı formatı. Lütfen tutarı doğru formatta giriniz.", vbExclamation
        Cancel = True
    End If
End Sub

Sub VeriAktar()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("SayfaAdı")
    Dim satirNo As Long
    satirNo = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    Dim tutar As Double
    tutar = CDbl(Replace(Replace(Me.TutarTextBox.Text, ".", ""), ",", "."))
    With ws.Cells(satirNo, "A")
        .NumberFormat = "#.##0,00"
        .Value = tutar
    End With
End Sub

Sub sayıyaçevir()
Dim i As Long
i = Cells(65536, "B").End(xlUp).Row
Range("G1").Copy
Range("B2:B" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("G1").Select
End Sub

bu kodda G1 e 1 yazmama rağmen 1 ile çarpmıyor. Aslında metin gibi görünen sayıları 1 ile çarpmak onları sayıya dönüştürüyormuş ama bu kodda ne eksik ki?

Sub sayıyaçevir()
    Dim i As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    i = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ws.Range("G1").Value = 1
    ws.Range("G1").Copy
    ws.Range("B2:B" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ws.Range("G1").Select
End Sub

ya da

Sub sayıyaçevir()
    Dim i As Long
    Dim rng As Range
    Dim ws As Worksheet
    Set ws = ActiveSheet
    i = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set rng = ws.Range("B2:B" & i)
    Application.ScreenUpdating = False
    With rng
        .NumberFormat = "General"
        .Value = .Value
    End With
    Application.ScreenUpdating = True
End Sub