Eşleme sonucu olmayan isim..

[dj_iso06]

MAKRO KULLANARAK BİR BUTONA BASIP İSİM LİSTESİ SEKMESİNDEKİ İSİMLERİN SARI ALAN İÇERİSİNDE OLUP OLMADAĞINI VE AYNI ZAMANDA SARI ALAN İÇERİSİNDE BULUNAN İSİMLERİN LİSTEDE EKLİ OLUP OLMADIĞINI BELİRTECEK BİR KOD YAZILABİLİRMİ? VE BU İSİMLER FARKLILIK GÖSTEREREK YADA MsgBOX ta UYARI VEREREK BELİRTİLEBİLİRMİ?
yardımlarınız için şimdiden teşekkürler.. Örnek dosya Ek'tedir..

 

[halit3]

MAKRO KULLANARAK BİR BUTONA BASIP İSİM LİSTESİ SEKMESİNDEKİ İSİMLERİN SARI ALAN İÇERİSİNDE OLUP OLMADAĞINI VE AYNI ZAMANDA SARI ALAN İÇERİSİNDE BULUNAN İSİMLERİN LİSTEDE EKLİ OLUP OLMADIĞINI BELİRTECEK BİR KOD YAZILABİLİRMİ? VE BU İSİMLER FARKLILIK GÖSTEREREK YADA MsgBOX ta UYARI VEREREK BELİRTİLEBİLİRMİ?
yardımlarınız için şimdiden teşekkürler.. Örnek dosya Ek'tedir..

Bunu denermisiniz.

Sub bul()
For i = 2 To Worksheets("İSİM LİSTESİ").Cells(Rows.Count, "a").End(3).Row
aranan = Sheets("İSİM LİSTESİ").Cells(i, 1).Value
With Worksheets("ANA SAYFA").Range("A1:M54")
Set d = .Find(aranan, LookIn:=xlValues)
If Not d Is Nothing Then
FirstAddress = d.Address
Do
Sheets("İSİM LİSTESİ").Cells(i, 2).Value = d.Address
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> FirstAddress
End If
End With
Next
 
For Each X In Worksheets("ANA SAYFA").Range("A1:M54")
If X.Value <> "" Then
aranan1 = X.Value
son = 0
For i = 2 To Worksheets("İSİM LİSTESİ").Cells(Rows.Count, "a").End(3).Row
If aranan1 = Sheets("İSİM LİSTESİ").Cells(i, 1).Value Then
son = 1
End If
Next
If son = 0 Then
MsgBox aranan1 & "  yok"
End If
End If
Next X
[COLOR=red][B]MsgBox " Arama tamamlanmıştır."
[/B][/COLOR]End Sub

 

[dj_iso06]

bunu denermisiniz.

sub bul()
for i = 2 to worksheets("isim listesi").cells(rows.count, "a").end(3).row
aranan = sheets("isim listesi").cells(i, 1).value
with worksheets("ana sayfa").range("a1:m54")
set d = .find(aranan, lookın:=xlvalues)
ıf not d ıs nothing then
firstaddress = d.address
do
sheets("isim listesi").cells(i, 2).value = d.address
set d = .findnext(d)
loop while not d ıs nothing and d.address <> firstaddress
end ıf
end with
next
 
for each x ın worksheets("ana sayfa").range("a1:m54")
ıf x.value <> "" then
aranan1 = x.value
son = 0
for i = 2 to worksheets("isim listesi").cells(rows.count, "a").end(3).row
ıf aranan1 = sheets("isim listesi").cells(i, 1).value then
son = 1
end ıf
next
ıf son = 0 then
msgbox aranan1 & "  yok"
end ıf
end ıf
next x
end sub

hocam teşekkür ederim ellerinize sağlık. Bir de buna arama tamamlanmıştır diye bir msgbox ilave edebilirmiyz peki?

 

[halit3]

2 nolu mesajda gerekli ekleme yapıdı.

 

[dj_iso06]

2 nolu mesajda gerekli ekleme yapıdı.

çok teşekkür ederim hocam. Bir şey daha rica edecem kusura bakmayın. isim karşısına hangi hücrede olduğunu değilde kaç kere yazıldığını belirtecek bir kod yazabilirmiyiz? Hakkınızı helal edin.. Allah razı olsun

 

[dj_iso06]

çok teşekkür ederim hocam. Bir şey daha rica edecem kusura bakmayın. isim karşısına hangi hücrede olduğunu değilde kaç kere yazıldığını belirtecek bir kod yazabilirmiyiz? Hakkınızı helal edin.. Allah razı olsun

ana sayfada uyuşmayan isim renk değiştirebilirmi?

 

[halit3]

ana sayfada uyuşmayan isim renk değiştirebilirmi?

kod:

Sub bul()
Worksheets("İSİM LİSTESİ").Columns("B:B").ClearContents
For i = 2 To Worksheets("İSİM LİSTESİ").Cells(Rows.Count, "a").End(3).Row
aranan = Sheets("İSİM LİSTESİ").Cells(i, 1).Value
With Worksheets("ANA SAYFA").Range("A1:M54")
Set d = .Find(aranan, LookIn:=xlValues)
If Not d Is Nothing Then
FirstAddress = d.Address
Do
Sheets("İSİM LİSTESİ").Cells(i, 2).Value = Sheets("İSİM LİSTESİ").Cells(i, 2).Value + 1
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> FirstAddress
End If
End With
Next
For Each X In Worksheets("ANA SAYFA").Range("A1:M54")
If X.Value <> "" Then
aranan1 = X.Value
son = 0
For i = 2 To Worksheets("İSİM LİSTESİ").Cells(Rows.Count, "a").End(3).Row
If aranan1 = Sheets("İSİM LİSTESİ").Cells(i, 1).Value Then
son = 1
End If
Next
If son = 0 Then
X.Interior.ColorIndex = 3
MsgBox aranan1 & "  yok"
End If
End If
Next X
MsgBox " Arama tamamlanmıştır."
End Sub

 

[dj_iso06]

kod:

Sub bul()
Worksheets("İSİM LİSTESİ").Columns("B:B").ClearContents
For i = 2 To Worksheets("İSİM LİSTESİ").Cells(Rows.Count, "a").End(3).Row
aranan = Sheets("İSİM LİSTESİ").Cells(i, 1).Value
With Worksheets("ANA SAYFA").Range("A1:M54")
Set d = .Find(aranan, LookIn:=xlValues)
If Not d Is Nothing Then
FirstAddress = d.Address
Do
Sheets("İSİM LİSTESİ").Cells(i, 2).Value = Sheets("İSİM LİSTESİ").Cells(i, 2).Value + 1
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> FirstAddress
End If
End With
Next
For Each X In Worksheets("ANA SAYFA").Range("A1:M54")
If X.Value <> "" Then
aranan1 = X.Value
son = 0
For i = 2 To Worksheets("İSİM LİSTESİ").Cells(Rows.Count, "a").End(3).Row
If aranan1 = Sheets("İSİM LİSTESİ").Cells(i, 1).Value Then
son = 1
End If
Next
If son = 0 Then
X.Interior.ColorIndex = 3
MsgBox aranan1 & "  yok"
End If
End If
Next X
MsgBox " Arama tamamlanmıştır."
End Sub

makro hata veriyor hocam

 

[halit3]

Bende çalışıyor ne hatası alıyorsunuz.