Koşula Göre Yazma

[steppe]

Merhaba Arkadaşlar,

Siteden epeyce araştırdım.Fakat aşağıdaki kodun hızlı ve doğru sonuç verenini bulamadım.

Sub kosula_gore_yaz()
On Error Resume Next
For i = 1 To 65536
If Cells(i, "A") = "Mehmet Gümüş" And Cells(i + 1, "A") = "Osmaniye" Then Cells(i + 2, "A") = "2487766"
If Cells(i, "A") = "Hasan Uslu" And Cells(i + 2, "A") = Empty Then Cells(i + 2, "A") = "3224433"
Next i
End Sub

Kodunun hızlı ve doğru sonuç verenini yapabilir miyiz?
Yardımlarınız için şimdiden teşekkür ederim.

 

[turist]

Deneyin.

Sub kosula_gore_yaz()
On Error Resume Next
son = Cells(Rows.Count, 1).End(3).Row
For i = 1 To son
If Cells(i, "A") = "Mehmet Gümüş" And Cells(i + 1, "A") = "Osmaniye" Then Cells(i + 2, "A") = "2487766"
If Cells(i, "A") = "Hasan Uslu" And Cells(i + 2, "A") = Empty Then Cells(i + 2, "A") = "3224433"
Next i
End Sub

 

[steppe]

Hocam Merhaba,
Hemen imdadımıza yetişiyorsunuz.İlginiz için çok teşekkür ederim.Yalnız dosyayı yeniden güncelledim. Deneye bilirseniz hatalı sonuç veriyor.İyi çalışmalar.

 

[turist]

Gördüğüm kadarı ile sonuç hatalı değil.
Ancak;
Sayfa1 de A sütununun biçimlendirmesini "Genel" yapın.Sonra kodu çalıştırın.
(Tarih olarak biçimlendirilmiş hücre olduğu için hatalı görüntü çıkmış)
Kolay gelsin...

 

[turist]

Veya;
Kodu şu şekilde düzenleyin.

Sub kosula_gore_yaz_1()
On Error Resume Next
ActiveSheet.Columns("A:A").NumberFormat = "General"
son = Cells(Rows.Count, 1).End(3).Row
For i = 1 To son
If Cells(i, "A") = "Mehmet Gümüş" And Cells(i + 1, "A") = "Osmaniye" Then Cells(i + 2, "A") = "2487766"
If Cells(i, "A") = "Hasan Uslu" And Cells(i + 2, "A") = Empty Then Cells(i + 2, "A") = "3224433"
Next i
End Sub

 

[steppe]

Hocam Merhaba,
A sütunun biçimlendirmesi değil onu düzeltirim. Gönderdiğim dosyada "kosula_gore_yaz_1" çalıştırdığımda sarı renkli kısım hatalı sonuç veriyor.
İyi günler.

 

[turist]

Dosyanızı tekrar inceledim, görünürde hiçbir sorun yok
Yeni bir dosya açın.
Sayfa 1 deki verilerinizin "makro çalıştırmadan önceki" orjinal halini Yeni sayfaya yazın.
Daha sonra makroların bulunduğu sayfada Modüle kısmına yeni bir modül ekleyin.
(Alt tuşuna basılı tutun ve F11 tuşuna basın makrolar için VBA sayfası açılır)
#5 no.lu mesajdaki kodu bu modüle yazın.
Sonra, Yeni sayfada iken makroyu çalıştırın.(Alt tuşuna basılı tutun ve F8 tuşuna basın makro penceresi açılır, oradan makroyu çalıştırın)

 

[turist]

Veya;
Ekli dosyayı kullanın.

 

[steppe]

Hocam,
İlginiz ve yardımlarınız için çok teşekkür ederim.
iyi günler

 

[turist]

Sağolun.
İyi çalışmalar...