• DİKKAT

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

Tıklanan satırda sabit bir sütuna aktarma

Katılım
26 Kasım 2006
Mesajlar
234
Excel Vers. ve Dili
2010-2013 Türkçe
Merhaba
(A) SÜTUNUNDAKİ HER HANGİ BİR HÜCREYE TIKLADIĞIMDA
userform1 açılsın ve hangi satırdaysa o satırdaki (B) hücresindeki rakamın üzerine
Ekle textboxunda rakam varsa eklesin
Çıkar textboxunda rakam varsa çıkarsın
ve sonucu tekrar B SÜTÜNUNDAKİ TIKLAMANIN YAPILDIĞI SATIRA YAZSIN

Textboxlara yazılan veri mümkünse sayı formatında olsun virgüllüde yazılabilsin.

Tşk.
 

Ekli dosyalar

Merhaba,

"Sayfa1" isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayın.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 1 Then UserForm1.Show
End Sub

Formunuzun kod bölümündeki var olan kodları silip aşağıdaki kodu uygulayıp deneyin.

Kod:
Private Sub CommandButton1_Click()
    Dim Data1, Data2
    
    If TextBox1 = "" Then
        Data1 = 0
    Else
        Data1 = TextBox1
    End If
    If TextBox2 = "" Then
        Data2 = 0
    Else
        Data2 = TextBox2
    End If
    
    ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1) + Data1 - Data2
    Unload Me
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case VBA.Asc("0") To VBA.Asc("9")
        Case VBA.Asc(",")
    Case Else
        KeyAscii = 0
        MsgBox "Sadece rakam girebilirsiniz.", vbExclamation
        TextBox1.SelStart = VBA.Len(TextBox1)
    End Select
End Sub
 
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case VBA.Asc("0") To VBA.Asc("9")
        Case VBA.Asc(",")
    Case Else
        KeyAscii = 0
        MsgBox "Sadece rakam girebilirsiniz.", vbExclamation
        TextBox2.SelStart = VBA.Len(TextBox2)
    End Select
End Sub
 
Merhaba,

"Sayfa1" isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayın.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 1 Then UserForm1.Show
End Sub

Formunuzun kod bölümündeki var olan kodları silip aşağıdaki kodu uygulayıp deneyin.

Kod:
Private Sub CommandButton1_Click()
    Dim Data1, Data2
    
    If TextBox1 = "" Then
        Data1 = 0
    Else
        Data1 = TextBox1
    End If
    If TextBox2 = "" Then
        Data2 = 0
    Else
        Data2 = TextBox2
    End If
    
    ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1) + Data1 - Data2
    Unload Me
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case VBA.Asc("0") To VBA.Asc("9")
        Case VBA.Asc(",")
    Case Else
        KeyAscii = 0
        MsgBox "Sadece rakam girebilirsiniz.", vbExclamation
        TextBox1.SelStart = VBA.Len(TextBox1)
    End Select
End Sub
 
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case VBA.Asc("0") To VBA.Asc("9")
        Case VBA.Asc(",")
    Case Else
        KeyAscii = 0
        MsgBox "Sadece rakam girebilirsiniz.", vbExclamation
        TextBox2.SelStart = VBA.Len(TextBox2)
    End Select
End Sub

Teşekkür Ederim Korhan Bey
 
Geri
Üst