Eger...bu formülün makrosu yazilabilir mi ?

[dennisf06]

EĞER(B2="";"";EĞER(EHATALIYSA((DÜŞEYARA(B2;Sayfa2!$D$2:$D$5000;1;0)=B2));"HATALI";""))

merhaba

dosyamda kullanmak istedigim yukardaki formülün makrosu yazilabilir mi acaba ? formülü 10000 satira kopyaladim dosyam iyice hantallasti. yetersiz makro bilgim oldugu icin formdaki önerleri uyarlayamadim. simdiden ilginiz icin cok tesekkür ederim.

 

[Skorpiyon]

Sayın dennisf06,

Kullanmış olduğunuz formülde Sayfa1'e yazılan rakam Sayfa2'de aynı satırda ise hata vermiyor. Eğer rakam var olduğu halde farklı bir satırda ise "HATALI" olarak yazıyor. Eğer istediğiniz böyle bir şey ise Ek'li dosyayı inceleyiniz. Makro ile yapılmıştır ve 10000 satırda ne kadar yavaşlar bilemiyorum, siz deneyerek test edersiniz.

 

[Kemal Demir]

Merhaba,

Sub Vlookup()
On Error Resume Next
say = Sheets(2).[d65536].End(3).Row
For c = 2 To Sheets(1).[b65536].End(3).Row
Sheets(1).Cells(c, 3) = WorksheetFunction.Vlookup(Sheets(1).Cells(c, 2), Sheets(2).Range("d2:d" & say), 1, 0)
If Cells(c, 3) = "" Then
Cells(c, 3) = "Veri Yok"
End If
Next
End Sub

Yukarıdaki kodu deneyiniz.

 

[dennisf06]

Sn Saban bey tesekkür ederim ilginize. yalniz benden kaynaklanan bir yanlisi düzelterek dosyayi tekrar ekliyorum. sayfa1 deki tabloya yazdigim rakam sayfa 2 de yoksa hata versin istiyorum. bir de hata mesajini hücre icerisinde degilde mesaj box da verdirmek mümkün mü acaba. saygilarimla...

 

[dennisf06]

Dosyami eklemeyi unuttum.

 

[Kemal Demir]

Sub Vlookup()
On Error Resume Next
say = Sheets(2).[d65536].End(3).Row
For c = 2 To Sheets(1).[b65536].End(3).Row
Sheets(1).Cells(c, 3) = WorksheetFunction.Vlookup(Sheets(1).Cells(c, 2), Sheets(2).Range("d2:d" & say), 1, 0)
If Cells(c, 3) = "" Then
[b]'Cells(c, 3) = "Veri Yok"[/b]
MsgBox ("Hata Var"), vbCritical, "Dikkat"

[b]'Sarı renge boyar[/b]
Cells(c,3).interior.Colorindex=6

End If
Next
End Sub

Alternatiftir.(Şaban hocamın çözümü saha sağlıklıdır)

 

[dennisf06]

Sn Rakkas bey tesekür ederim size de. benden kaynaklanan bir yanlisla Sn Saban bey in cözümü farkli bir cözüm olmus. ama sizin alternatif kodunuz tam istedigim isi yapiyor. sadece sizden bir ricam bu uyariyi hücre icerisinde degilde uyari mesaji seklinde nasil yapilir. saygilarimla...

 

[Kemal Demir]

Şaban hocam'ın izni ile,

6 mesajdaki kod uyarı mesajı veriyor.

Tekrar Şaban hocam'ın izni ile.

 

[dennisf06]

Sn Rakkas bey makro bilgimi maruz görün lütfen. eklediginiz dosya üzerinde sayfa1 deki sari tabloya rakam girdigim halde hic bir uyari alamadim. sayfa1 de tabloya yazdigim rakam sayfa2 de yoksa uyari versin istemistim. biraz önce ne yaptigimi anlayamadim. örnek bir dosya eklerseniz cok memnun olurum.saygilarimla.

 

[Kemal Demir]

Merhaba,

Ek'teki örneği inceleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
ilknokta = Target.Address
deger = Target.Value
say = WorksheetFunction.CountIf(Sheets(2).Range("d2:d14"), deger)
If say >= 1 Then
Else
MsgBox ("Hata")
Range(ilknokta).Interior.ColorIndex = 6
End If
End Sub

Umarım iş görür.(Şaban Hocam Ayıp etmedim umarım )

 

[dennisf06]

ne diyecegimi bilmiyorum. süper. emeklerinize bir kuru tesekkür edebiliyoruz ancak. bir de sari renki nasil kirmizi yapabilirim acaba.

 

[dennisf06]

tamam buldum hocam. saglicakla kalin.

 

[Ali]

Aşağıdaki kodları Boş bir excel sayfasındaki bir modüle ekleyip çalıştırın. Böylece tüm renklerin kodlarını görmüş olursunuz.

Sub renktest()
For i = 1 To 56
Cells(i, 1).Interior.ColorIndex = i
Cells(i, 2) = i
Next
End Sub

 

[Kemal Demir]

Range(ilknokta).Interior.ColorIndex = 3

 

[dennisf06]

hocam affiniza siginarak bir soru sormak istiyorum. bu gün cok vaktinizi aldim. hatali sayida hücre kirmizi oluyor ama sayiyi sildikten sonra kirmizi hücrede kaliyor.ayrica hatali sayiyi silince gene hata mesaji veriyor. hücre eski rengini almiyor.

 

[Necdet]

Merhaba,

Konuya sonradan dahil olunca anlamak zorlaşıyor.
Bir kendimi deneyim

Aşağıdaki kodları ilgili sayfanın kod bölümünde olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target.Value = "" Then
    Target.Interior.ColorIndex = xlNone
Else
    Set Bul = Sheets("Sayfa2").Columns("D").Find(Target, lookat:=xlWhole)
    If Bul Is Nothing Then
        Target.Interior.ColorIndex = 3
        MsgBox "Bulamadım " & Target.Value & " Değerini"
    Else
        Target.Interior.ColorIndex = xlNone
    End If
End If
Son:
End Sub

 

[Kemal Demir]

Necdet hocam,

Güzel bir çalışma olmuş.

 

[Necdet]

Teşekkürler Sayın Rakkas,

Umarım sorunu doğru anlamışımdır.

 

[dennisf06]

Sayin Necdet hocam hakikaten harika olmus. madem konuya dahil oldunuz bir sorum olacakti.hocam ikili sorgulamayi da buna ekleyebilirmiyiz. Yani fatura numarasini ve malzemeyi yazdigim zaman ayni eslesme sayfa 2 de yoksa hata mesaji versin.dosyada olayi örneklendirdim.saygilarimla...

 

[Necdet]

Merhaba,

Sorunuzu anlar gibi oldum ama şöyle birşey önerdim, sizce de olur mu bilmiyorum.

Malzeme kodunu girince malzeme adı gelse olmaz mı?

Eğer olmaz derseniz ikili kontrolün üzerine gideriz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target.Value = "" Then
    Target.Interior.ColorIndex = xlNone
    Target.Offset(0, 1) = ""
Else
    Set Bul = Sheets("Sayfa2").Columns("D").Find(Target, lookat:=xlWhole)
    If Bul Is Nothing Then
        Target.Interior.ColorIndex = 3
        Target.Offset(0, 1) = ""
        MsgBox "Bulamadim " & Target.Value & " Degerini"
    Else
        Target.Interior.ColorIndex = xlNone
        Target.Offset(0, 1) = Sheets("Sayfa2").Cells(Bul.Row, "E")
    End If
End If
Son:
End Sub