Eğeri makro ile yazma

[designer41]

Arkadaşlar
eğer b sutundaki ali lerin d sutunundaki kalşılığı boşsa hiç bişey yapma.
eğer b sutunundaki ali nin d sutunudaki karşılığı dolu ise b hücresindeki ali nin sonuna 1 ekle formülüne nasıl bir makro yazılabilir.

 

[designer41]

böyle bir makro yazılamaz mı bilen yok mu acaba?

 

[Husgvarna]

böyle bir makro yazılamaz mı bilen yok mu acaba?

Merhaba.
Yardımcı bir sütun kullanılarak ek dosyadaki gibi olabilir.

 

[designer41]

Merhaba.
Yardımcı bir sütun kullanılarak ek dosyadaki gibi olabilir.

Cevabınız için teşekkür ederim
Ancak makro; Ali özel ismine göre olması gerekiyor diğer isimleri hiç sorgulamayacak.
Private Sub Worksheet_Change(ByVal Target As Range)
makro bunun içine yazılacak ,buton olmayacak
End Sub
b sutununda ki Ali lerin karşılığı olan c sutununda soyad varsa makro devreye girecek.

 

[Husgvarna]

Cevabınız için teşekkür ederim
Ancak makro; Ali özel ismine göre olması gerekiyor diğer isimleri hiç sorgulamayacak.
Private Sub Worksheet_Change(ByVal Target As Range)
makro bunun içine yazılacak ,buton olmayacak
End Sub
b sutununda ki Ali lerin karşılığı olan c sutununda soyad varsa makro devreye girecek.

Merhaba.
Yalnız "Ali" için şöyle deneyin.

 Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="Red"]If Target.Column = 2 Or Target.Column = 4 Then[/COLOR]
For i = Cells(65000, 2).End(xlUp).Row To 2 Step -1
Set x = Range("b" & i - 1 & ":b" & Cells(65000, 2).End(xlUp).Row).Find(What:="[COLOR="Red"]Ali[/COLOR]", LookIn:=xlValues, LookAt:=xlPart)
If Not x Is Nothing Then
If IsNumeric(Split(Cells(x.Row, 2), "[COLOR="Red"]Ali[/COLOR]")(1)) Then
c = Split(Cells(x.Row, 2), "[COLOR="#ff0000"]Ali[/COLOR]")(1)
Exit For
End If
End If
Next
For a = 2 To Cells(65000, 2).End(xlUp).Row
Set b = Range("b" & a & ":b" & Cells(65000, 2).End(xlUp).Row).Find(What:="[COLOR="#ff0000"]Ali[/COLOR]", LookIn:=xlValues, LookAt:=xlWhole)
If Not b Is Nothing Then
If Cells(b.Row, 4) <> "" Then
c = c + 1
Cells(b.Row, 2) = Cells(b.Row, 2) & c
End If
Else
Exit Sub
End If
Next
End If
End Sub

 

[honestman]

Merhaba,

benzer bir şekilde aşağıdaki if fonksiyonunu nasıl makro haline getirebiliriz?
Teşekkürler




=IF(Z2<=1500;1500;IF(Z2<=4999;5000;IF(Z2<=9999;9999;IF(Z2>10000;"10.000'DEN BÜYÜK"))))

 

[designer41]

Merhaba.
Yalnız "Ali" için şöyle deneyin.

 Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("e2:d65000")) Is Nothing Then
For i = Cells(65000, 2).End(xlUp).Row To 2 Step -1
Set x = Range("b" & i - 1 & ":b" & Cells(65000, 2).End(xlUp).Row).Find(What:="[COLOR="Red"]Ali[/COLOR]", LookIn:=xlValues, LookAt:=xlPart)
If Not x Is Nothing Then
If IsNumeric(Split(Cells(x.Row, 2), "[COLOR="Red"]Ali[/COLOR]")(1)) Then
c = Split(Cells(x.Row, 2), "[COLOR="#ff0000"]Ali[/COLOR]")(1)
Exit For
End If
End If
Next
For a = 2 To Cells(65000, 2).End(xlUp).Row
Set b = Range("b" & a & ":b" & Cells(65000, 2).End(xlUp).Row).Find(What:="[COLOR="#ff0000"]Ali[/COLOR]", LookIn:=xlValues, LookAt:=xlWhole)
If Not b Is Nothing Then
If Cells(b.Row, 4) <> "" Then
c = c + 1
Cells(b.Row, 2) = Cells(b.Row, 2) & c
End If
Else
Exit Sub
End If
Next
End If
End Sub

Sayın Husgvarna öncelikle çok teşekkür ederim ilgine
yukarıdaki kodları ekledim ancak hiç bişe olmadı ekli dosya ya siz ekleyebilirmisiniz acaba?
ben beceremedim sanırım.

 

[Husgvarna]

Sayın Husgvarna öncelikle çok teşekkür ederim ilgine
yukarıdaki kodları ekledim ancak hiç bişe olmadı ekli dosya ya siz ekleyebilirmisiniz acaba?
ben beceremedim sanırım.

Ek dosyayı inceleyin. kod "B" ve "D" sütunlarına veri girildiğinde çalışacaktır.
(Hata "B" ve "D" sütunlarına veri girildiğinde çalışmasını gerektiren bölümden kaynaklanmış.)

 

[designer41]

Sayın Husgvarna ellerine sağlık kod çalışıyor,
Çok teşekkür ederim ellerin dert görmesin.

 

[Husgvarna]

Sayın Husgvarna ellerine sağlık kod çalışıyor,
Çok teşekkür ederim ellerin dert görmesin.

Sağolun.
Dikkat etmeniz gereken şey: "B" sütunundaki hücrelerde "Ali" şeklinde olmalı; hücrelerde "ALİ" veya ""ali" şeklinde büyük küçük harf değişikliğinde "ALİ1", "ali1" gibi sonuçlar çıkacaktır. Üstünde çalıştığınız asıl dosyanızı (değiştirerek) eklemiş olsaydınız daha pratik ve daha iyi çözümler bulunabilirdi.
İşinize yaradıysa ne güzel. Kolay gelsin.