Hücrede yıldız (*) işareti varsa.

[k0081]

Merhaba arkadaşlar;

D5 hücresinde yıldız (*) karakteri varsa makro1 çalışsın.. D5 hücresinde ki yıldız tek başına değil.. bu şekilde.. ----> 25*65 yada 15*1200 veya 36*6000

yıldız yoksa D5 yine de boş değil,, sayı vardır.. 6000 , 8100 , 1200 gibi...

yardımcı arkadaşa şimdiden teşekkürler..

 

[uzmanamele]

Merhaba

Bu işinizi görür mü?

Sub deneme()
On Error GoTo 10
yildiz = Application.WorksheetFunction.Find("*", Range("d5"), 1)
MsgBox "Makro Çalıştı..."
10
End Sub

 

[k0081]

Merhaba

Merhaba hocam.

göndermiş olduğunuz bu kod ile macroyu hazırladım.. çalıştı.. çok teşekkür ederim..

Yalnız şöyle bişey var: Ağır çalışıyor.. tablom epey bi kalabalık olduğu için. Application.WorksheetFunction.Find
bu kısımdan kaynaklanıyor sanırım.. buraya KOLON olarak Sayfa ismi verebilirmiyiz acaba..?

 

[uzmanamele]

Merhaba

Kodu nasıl tetikliyorsunuz?
Kod ile hangi hücreler aralığına bakıyorsunuz?
Bunları bilmeden önereceğimiz kod ancak önceki mesajımdaki gibi olabilir!

 

[k0081]

Merhaba


Hücre aralığı yok Hocam. sadece bir tek hücre var. oda D5 hücresi.

Tetikleme ise bu şekilde worksheet_change ile..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim yildiz
On Error GoTo 10
yildiz = Application.WorksheetFunction.Find("*", Range("d5"), 1)
Call carp
10

bu kodda çağıralacak macro..

Sub carp()
' Klavye Kısayolu: Ctrl+y
'
Dim ilk
Dim son
ilk = Split(Range("D5"), "*")(0)
son = Split(Range("D5"), "*")(1)
Range("E3") = ilk * son
Range("D5") = "=E3"
End Sub

 

[Korhan Ayhan]

Merhaba,

Süleyman beyin önerdiği kodu boş bir dosyada denedim. Herhangi bir yavaşlama yaşamadım. Alternatif olarak aşağıdaki kodu da deneyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If InStr(1, [D5], "*", vbTextCompare) > 0 Then carp
End Sub

 

[uzmanamele]

Merhaba

Bunu ekleyerek deneyiniz.

If Intersect(Target, Range("d5")) Is Nothing Then Exit Sub

 

[k0081]

Merhaba;

Süleyman ve Korhan hocam çok teşekkürler tamamdır..