yüzdesi ....olan sayıyı bulma

[serkan guvenc]

D ve e sutununa rakam girildiğinde yüzde 40 ve yüzde altmışını alıyor.
b ve c sütününa d 'de yüzde 40 olan sayıyı bulup yazmasını e yede yüzde 60'nı yazdırmak istiyorum
d ve e sütününda boş hüzrelerde var.Makro ile nasıl yapabilirim
Teşekkürler

 

[bmutlu966]

Eğer yanlış anlamadıysam. B kolonuna rakamı girip D kolonunda bu rakamın %40'ını E kolonunda da %60'ını görmek istiyorsunuz.

Eğer öyleyse aşağıdaki kodu deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("B1:B1000")) Is Nothing Then Exit Sub
If Not IsNumeric(Target) Then MsgBox "Rakam giriniz": Exit Sub

Target.Offset(, 2) = Target.Value * 0.4
Target.Offset(, 3) = Target.Value * 0.6

End Sub

 

[serkan guvenc]

hayır d kolonundaki % 40 olan sayıyın ve e kolonuda %60 olan sayıyı arıyorum
yani % 40 400 olan sayının tamamını arıyorum

 

[bmutlu966]

Deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If kontrol = 1 Then Exit Sub
    If Selection.Count > 1 Then Exit Sub
    kontrol = 0
    If IsNumeric(Target) Then
        If Target.Column = 5 Then
            kontrol = 1
            Cells(Target.Row, "C") = Target.Value
            With Target
                .Value = .Value * 0.6
            End With
            GoTo son
        End If
    Else
        MsgBox "Sayısal bir değer yazmadınız.", , ""
    End If
If kontrol = 1 Then Exit Sub
    If Selection.Count > 1 Then Exit Sub
    kontrol = 0
    If IsNumeric(Target) Then
        If Target.Column = 4 Then
            kontrol = 1
            Cells(Target.Row, "B") = Target.Value
            With Target
                .Value = .Value * 0.4
            End With
            GoTo son
        End If
    Else
        MsgBox "Sayısal bir değer yazmadınız.", , ""
    End If
son:
kontrol = 0
End Sub

 

[Korhan Ayhan]

Alternatif..

Eski kodlarınızı silip aşağıdaki kodu uygulayın.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range

    On Error GoTo 10
   
    If Intersect(Target, Range("D:E")) Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
   
    For Each Rng In Target
        If Not IsNumeric(Rng.Value) Then
            MsgBox "Lütfen sayısal değer girişi yapınız!", vbCritical
            Target.ClearContents
            GoTo 10
        End If
        If Rng.Column = 4 Then
            Rng = Rng * 0.4
            Cells(Rng.Row, "B") = Rng * 100 / 40
            Cells(Rng.Row, "C") = Cells(Rng.Row, "B") - Rng
        End If
        If Rng.Column = 5 Then
            Rng = Rng * 0.6
            Cells(Rng.Row, "B") = Rng * 100 / 60
            Cells(Rng.Row, "C") = Cells(Rng.Row, "B") - Rng
        End If
    Next

10  Application.EnableEvents = True
End Sub

 

[serkan guvenc]

Public kontrol As Byte
Private Sub Worksheet_Change(ByVal Target As Range)
If kontrol = 1 Then Exit Sub
If Selection.Count > 1 Then Exit Sub
kontrol = 0
If IsNumeric(Target) Then
If Target.Column = 5 Then
kontrol = 1
Cells(Target.Row, "C") = Target.Value

With Target
.Value = .Value * 0.6
End With
GoTo son
End If
Else
MsgBox "Sayısal bir değer yazmadınız.", , ""
End If
If kontrol = 1 Then Exit Sub
If Selection.Count > 1 Then Exit Sub
kontrol = 0
If IsNumeric(Target) Then
If Target.Column = 4 Then
kontrol = 1
Cells(Target.Row, "B") = Target.Value
With Target
.Value = .Value * 0.4
End With
GoTo son
End If
Else
MsgBox "Sayısal bir değer yazmadınız.", , ""
End If
son:
kontrol = 0
End Sub
Bu kod daha çok işime yaradı tek sorun c ve b sutununa atarken yüzzdesi alınan değerden çıkarmasını isityorum
yani 1000 'in % 40 ını aldıktan sınra c sutununa 600 yazması örnek

 

[Korhan Ayhan]

Doğru anlamak adına yazıyorum.

D1 hücresine 1000 yazdınız. Sonuç ne olmalı? (Hücre adresleri vererek cevaplayınız.)
E1 hücresine 1000 yazdınız. Sonuç ne olmalı? (Hücre adresleri vererek cevaplayınız.)

 

[serkan guvenc]

D1 HÜCRESİNE YAZILAN 1000 SAYISININ %40 HESAPLANIP YAZIYOR D1 HÜCRESİNE % 40 GELİYOR YANİ 400 GELİYOR SORUN YOK
BU YAZDIĞIM SAYI B1 HÜCRESİNE (YÜZDESİNİ ALDIĞIM SAYI )Yazıyor. sorun yok güzel çalışıyor.
Sorum b1 hücresine gelen sayı yanı 1000 rakamı yüzdesi alınan sayıyadan çıkarılmasını yapmaya çalışıyorum yan b1 hücresindeki 1000 yerine 600 yazmasını isityorum

 

[Korhan Ayhan]

E sütunu devre dışımı kaldı?

 

[serkan guvenc]

Yok e sütünuda aynı şekilde

 

[Korhan Ayhan]

#5 nolu mesajda önerdiğim kodu revize ettim. Son halini tekrar deneyiniz.