Tek hücrede iki İşlem

[sirkülasyon]

Değerli Uzmanlarım
Bir ricam var. Excel de mümkün müdür? Mümkün değil midir? Bilmiyorum.
Eğer mümkünse yardımlarınızı bekliyorum.

Ricam şu:
Örneğin Bir hücreye 156,60 TL olarak manuel giriş yaptığım zaman bana KDV' li mi diye soru soracak Evet denildiği zaman hücrede bulunan rakamı 1,08' e bölecek hücrede 156,60 - 145,00 TL Yazacak. Yazıcıda çıktı alınırken de 156,60 görünecek. 145,00 TL görünmeyecek.

Bu işlem K4:4250 arasında ki hücreler de yapılacak.

Teşekkür eder, saygılarımı sunarım

 

[askm]

Söylediğiniz gibi her seferinde size KDV li mi diye sorması işlemi çok yavaşlatır. her işlem yapabilmesi için onay ister. Bunun yerine örneğin d hücresine KDV li mi EVET HAYIR seçtirerek girilen değere göre işlem yapması daha hızlı sonuç verir. Örnek tablonuzu paylaşırsanız daha çabuk işleyen çözüm olur.

 

[sirkülasyon]

üstad
güncel hali ile sizin belirttiğiniz gibi. Bu durum unutma kdv yi eklememe gibi sonuç yaratıyor. Bunun için böyle bir işlem ricasında bulundum.
Her seferinde evet hayır gibi sorması önemli değil. Çünkü bu işlem bir kere yapılacak. sürekli olan bir işlem değil.

 

[askm]

Aşağıdaki kodu deneyin.

Sub mesaj()
Range("K4:K250").ClearContents
For i = 4 To 250
If MsgBox("KDV Eklensin mi?", vbYesNo, "ASKM") = vbYes Then
    Cells(i, 11) = Cells(i, 10) & " - " & WorksheetFunction.Round((Cells(i, 10) / 1.08), 2) & "-TL"
Else
    Cells(i, 11) = Cells(i, 10)
End If
Next

End Sub

Sub cikti()
Range("K4:K250").Copy Range("AA4")
Range("J4:J250").Copy Range("K4")
Sayfa1.PageSetup.PrintArea = "$A$1:$K$250"
Sayfa1.PrintPreview 'BASKI ÖNİZLEME
'Sayfa1.PrintOut 'ÇIKTI ALMA
Range("AA4:AA250").Copy Range("K4")
Range("AA4:AA250").ClearContents
End Sub

 

[sirkülasyon]

üstat bu tek hücre yerine 4:250 arasında hepsine soruyor

 

[askm]

Ben de onu dedim zaten. İşlem uzun sürer diye. K4-K250 arası tümüne tek soru ile KDV siz hesaplama mı istiyorsunuz.Onun için aşağıdaki şekilde deneyin. Ya da örnek şablonu ekleyin bakayım.

[/code]
Sub mesaj()
Range("K4:K250").ClearContents

If MsgBox("KDV Eklensin mi?", vbYesNo, "ASKM") = vbYes Then

For i = 4 To 250
Cells(i, 11) = Cells(i, 10) & " - " & WorksheetFunction.Round((Cells(i, 10) / 1.08), 2) & "-TL"
next
Else
For i = 4 To 250
Cells(i, 11) = Cells(i, 10)
Next
End If


End Sub

Sub cikti()
Range("K4:K250").Copy Range("AA4")
Range("J4:J250").Copy Range("K4")
Sayfa1.PageSetup.PrintArea = "$A$1:$K$250"
Sayfa1.PrintPreview 'BASKI ÖNİZLEME
'Sayfa1.PrintOut 'ÇIKTI ALMA
Range("AA4:AA250").Copy Range("K4")
Range("AA4:AA250").ClearContents
End Sub
[/code]

 

[sirkülasyon]

Üstat
ellerine sağlık ancak bir tek veri girilen hücre için sormuyor. tüm sütun için soruyor.
Veri girdikçe sorması için düzenleme yapabilir miyiz

 

[askm]

Aşağıdaki şekilde deneyin. Sayfanın kod kısmına eklenecek.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row > 4 And Target.Column = 10 Then
    If Target.Value <> "" Then
        If MsgBox("KDV Eklensin mi?", vbYesNo, "ASKM") = vbYes Then
            Target.Offset(0, 1) = Target & " - " & WorksheetFunction.Round((Target / 1.08), 2) & "-TL"
        Else
            Target.Offset(0, 1) = Target & "-TL"
        End If
    Else
        Target.Offset(0, 1) = Empty
    End If
End If
End Sub

 

[sirkülasyon]

Ellerine kollarına sağlık
Teşekkür Ederim