Virgülden sonraki rakamlar

[qwert0]

Merhaba;
virgülden öncesi aynı virgülden sonrası farklı alt alta sıralanmış rakamlarım var. virgülden önceki rakamı bi defa yazmak kaydıyla bi alt satıra sadece virgül koyup virgülden önceki rakamın gelmesini nasıl yapabilirim

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın.
A1 deki değerin tam sayı bölümünü alır, alt hücrelerde veri girerken virgül koyup veriyi girerseniz istediğiniz sonuca ulaşırsınız.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim deg As Double
 
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    
    deg = Val(Range("A1"))
    
    With Target
        If .Row < 2 Then Exit Sub
        If .Value = "" Then Exit Sub
        Application.EnableEvents = False
            .Value = deg + .Value
        Application.EnableEvents = True
    End With
 
End Sub

.

 

[sametozyavuz]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın.
A1 deki değerin tam sayı bölümünü alır, alt hücrelerde veri girerken virgül koyup veriyi girerseniz istediğiniz sonuca ulaşırsınız.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim deg As Double
 
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    
    deg = Val(Range("A1"))
    
    With Target
        If .Row < 2 Then Exit Sub
        If .Value = "" Then Exit Sub
        Application.EnableEvents = False
            .Value = deg + .Value
        Application.EnableEvents = True
    End With
 
End Sub

.

virgül konmadan yazıldığında ise tamsayı ile a1 hücresindeki değer toplanıyor.
bir de her seferinde bir üst hücredeki sayının tamsayısını alan bir kod olsa.

 

[Ömer]

virgül konmadan yazıldığında ise tamsayı ile a1 hücresindeki değer toplanıyor

Bu durumda ne olmalı?

.

 

[sametozyavuz]

Bu durumda ne olmalı?

.

hücreye veri girişi yapılırken ilk karakter , olduğunda kod çalışsın.
diğer tüm durumlarda herhangi bir işlem yapmasın.

 

[Ömer]

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim deg As Double
 
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    
    With Target
        If .Row < 2 Then Exit Sub
        deg = Val(.Offset(-1, 0))
        If .Value = "" Or .Value = 0 Then Exit Sub
        If IsNumeric(.Value) = False Then Exit Sub
        Application.EnableEvents = False
            If Left(.Value, 1) = 0 Then
                .Value = deg + .Value
            End If
        Application.EnableEvents = True
    End With
  
End Sub

.

 

[sametozyavuz]

bence tam olmuş. elinize sağlık.

 

[qwert0]

Teşekkürler işime cok yaradı fakat belirtilen hücrelerin üzerine veri kopyaladıgım zaman "Run time error '13': Type mismatch" Hatası alıyorum.