• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

- olan rakamları gösterme

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
582
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
arkadaşlar ekli dosyada bir sorunum var yardımcı olurmusunuz lütfen. teşekkür ederim.
 

Ekli dosyalar

Selamlar,

KAYDET butonunuzdaki kodu aşağıdaki ile değiştirip denermisiniz.

Kod:
Private Sub CommandButton1_Click()
    Dim SATIR As Long, X As Byte
    
    If TextBox1 = "" Then
        MsgBox "Lütfen tarih giriniz !", vbCritical, "Dikkat !"
        TextBox1.SetFocus
        Exit Sub
    End If
    
    If ComboBox1 = "" Then
        MsgBox "Lütfen ürün kodu giriniz !", vbCritical, "Dikkat !"
        ComboBox1.SetFocus
        Exit Sub
    End If
    
    If TextBox3 = "" Then
        MsgBox "Lütfen ürün miktarını giriniz !", vbCritical, "Dikkat !"
        TextBox3.SetFocus
        Exit Sub
    End If
    
    If TextBox8 = "-1" Then
        MsgBox "Lütfen kdv oranını giriniz !", vbCritical, "Dikkat !"
        TextBox8.SetFocus
        Exit Sub
    End If
    
    With Sheets("KAYIT_DEFTERİ")
        SATIR = .Range("A65536").End(3).Row + 1
        .Cells(SATIR, "A") = (TextBox1)
        .Cells(SATIR, "B") = ComboBox1
        .Cells(SATIR, "C") = TextBox2.Text
        .Cells(SATIR, "D") = CDbl(TextBox3)
        .Cells(SATIR, "E") = CDbl(TextBox4)
        .Cells(SATIR, "F") = CCur(TextBox5)
        .Cells(SATIR, "G") = CDbl(TextBox6)
        .Cells(SATIR, "H") = CCur(TextBox7)
        .Cells(SATIR, "I") = CDbl(TextBox8)
        .Cells(SATIR, "J") = CCur(TextBox9)
        .Cells(SATIR, "K") = CCur(TextBox10)
        .Cells(SATIR, "L") = CDate(TextBox15)
        [COLOR=red]If TextBox3 < 0 Then
        .Cells(SATIR, "M") = CDbl(TextBox3)
        .Cells(SATIR, "N") = CCur(TextBox5)
        End If[/COLOR]
    End With
    
    ComboBox1 = ""
    
    For X = 2 To 10
        Me.Controls("TextBox" & X) = ""
    Next
    
    UserForm_Initialize
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
 
Dosyanız Ekte.:cool:
Kod:
Sub eksikleri_aktar()
Dim i As Long
Sheets("KAYIT_DEFTERİ").Select
Application.ScreenUpdating = False
For i = 2 To Cells(65536, "B").End(xlUp).Row
    If Cells(i, "D").Value < 0 Then _
    Cells(i, "M").Value = Cells(i, "D").Value
    If Cells(i, "F").Value < 0 Then _
    Cells(i, "N").Value = Cells(i, "F").Value
Next i
Application.ScreenUpdating = True
MsgBox "Eksi değerler M ve N sütyunlarına aktarıldı.", vbOKOnly + vbInformation, "EKSİ DEĞERLER"
End Sub
 

Ekli dosyalar

Korha hocam ve evren hocam ikinizin kodlarıda oluyor çok teşekkür ederim ilginiz için.
 
Geri
Üst