• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

iki hücrede aynı ve farklı olan verileri bulma

B

burak_76_

Katılım
16 Şubat 2008
Mesajlar
47
Excel Vers. ve Dili
2003 tr
SAYIN HOCALAR YAPMAYA ÇALIŞTIĞIM ŞEY İKİ LİSTEDE AYNI
OLAN İSİM SOYİSİMİ Bİ RENKLE FARKLI OLAN LARI İSE FARKLI BİR RENKLE 1. LİSTEDE OLUPTA 2.LİSTEDE OLMAYANI FARKLI YADA 2. LİSTE
DE OLUPDA 1. LİSTEDE OLMAYANI FARKLI BİR RENKTE GÖSTERMEK İSTİYORUM BUNU YAPMAM MÜNKÜNMÜDÜR. bir buton olusturup butona bastığımızda bunların yapılmasını istiyorum. mükerrer kayıt örnekleri-14 de benzer birşey var ama istediğim o şekilde değil kod bilmediğimiz icin pek bişey yapamıyoruz.

ekte ayrıntılı bi örnek verdim yardımlarınızı bekliyorum
 

Ekli dosyalar

Merhaba, dosyanız ekte;

Kod: 
Sub excelweb()
   Range("IP1:IQ65000").ClearContents
For i = 5 To Range("b65536").End(xlUp).Row
Cells(i, 250).Value = Cells(i, 2).Value & Cells(i, 3).Value
Cells(i, 251).Value = Cells(i, 5).Value & Cells(i, 6).Value
Next
For g = 5 To Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("Iq:Iq"), Cells(g, 250)) > 0 Then
Range("B" & g & ":C" & g).Interior.ColorIndex = 6
Else
Range("B" & g & ":C" & g).Interior.ColorIndex = 55
End If
If WorksheetFunction.CountIf(Range("Ip:Ip"), Cells(g, 251)) > 0 Then
Range("e" & g & ":f" & g).Interior.ColorIndex = 6
Else
Range("e" & g & ":f" & g).Interior.ColorIndex = 4
End If
Next
End Sub
 

Ekli dosyalar

Son düzenleme:
Abdurrahim Kesimoğlu iki listede var ama yok diye çıkıyor sonuçta bunun sebebi yazım farklılığı birisinin sonunda boşluk var.
 
Altar örgeçtede aynı durum vardı bunu kodla düzeltelim kodu alttakiyle değiştirin,

Kod: 
Sub excelweb()
   Range("IP1:IQ65000").ClearContents
For i = 5 To Range("b65536").End(xlUp).Row
Cells(i, 250).Value = Trim(Cells(i, 2).Value) & Trim(Cells(i, 3).Value)
Cells(i, 251).Value = Trim(Cells(i, 5).Value) & Trim(Cells(i, 6).Value)
Next
For g = 5 To Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("Iq:Iq"), Cells(g, 250)) > 0 Then
Range("B" & g & ":C" & g).Interior.ColorIndex = 6
Else
Range("B" & g & ":C" & g).Interior.ColorIndex = 55
End If
If WorksheetFunction.CountIf(Range("Ip:Ip"), Cells(g, 251)) > 0 Then
Range("e" & g & ":f" & g).Interior.ColorIndex = 6
Else
Range("e" & g & ":f" & g).Interior.ColorIndex = 4
End If
Next
End Sub
 
sn. fedeal çok teşekkür ederim ancak çalışma sayfasında bir butono ekliyeceğim yapma imkanınız varmıdır. birde bu yapılananlar sayfa sonuna kadardır değilmi yani en alt satıra kadar .
 
Ne kadar veri varsa alır döngü kullanıldıgı için veri sayısı yüksldikçe hesaplama yavaşlar. 2.mesajdaki dosyayı güncelledim.
 
sn fedeal listeyi uzattığımda olmuyor örneğe bir göz atabilirmisiniz.
 

Ekli dosyalar

hocam tamamdır sorun hallaldu çok teşekkür ederim zaman ayırdığınız için. müsaitseniz bir soru daha sormak istiyorum forumda daha önce konuyu açmıştım ama yanıt alamamıştım.
 
fedeal' Alıntı:
Merhaba, dosyanız ekte;

Kod: 
Sub excelweb()
   Range("IP1:IQ65000").ClearContents
For i = 5 To Range("b65536").End(xlUp).Row
Cells(i, 250).Value = Cells(i, 2).Value & Cells(i, 3).Value
Cells(i, 251).Value = Cells(i, 5).Value & Cells(i, 6).Value
Next
For g = 5 To Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("Iq:Iq"), Cells(g, 250)) > 0 Then
Range("B" & g & ":C" & g).Interior.ColorIndex = 6
Else
Range("B" & g & ":C" & g).Interior.ColorIndex = 55
End If
If WorksheetFunction.CountIf(Range("Ip:Ip"), Cells(g, 251)) > 0 Then
Range("e" & g & ":f" & g).Interior.ColorIndex = 6
Else
Range("e" & g & ":f" & g).Interior.ColorIndex = 4
End If
Next
End Sub
Genişletmek için tıkla ...

sn arkadaşlar fedeal hocamın yapmış olduğu bu örnek üzerinde biraz değişiklik yapmak istiyorum ama yapamadım yeni eklediğim bir dosya var oda ekte hocamın yaptığı dosyaya bakarsanız biraz daha genişletmek istiyorum bu son örneğe bakabilirseniz sevinirim.
İki listede aynı olan isimleri 2.listedeki değer bölümünden 1.listeye aktarmayı ve daha sonrada üsteki örnekte gibi 1. LİSTEDE OLUPTA 2.LİSTEDE OLMAYANI FARKLI YADA 2. LİSTE
DE OLUPDA 1. LİSTEDE OLMAYANI FARKLI BİR RENKTE GÖSTERMEye çalışıyorum yardımlarınızı yine bekliyorum sağolun.
 

Ekli dosyalar

Dosyanız ekte,

Kod: 
Private Sub CommandButton1_Click()
   Range("IP1:IQ65000").ClearContents
For i = 5 To Range("b65536").End(xlUp).Row
Cells(i, 250).Value = Trim(Cells(i, 2).Value) & Trim(Cells(i, 3).Value)
Cells(i, 251).Value = Trim(Cells(i, 6).Value) & Trim(Cells(i, 7).Value)
Next
For g = 5 To Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("Iq:Iq"), Cells(g, 250)) > 0 Then
Range("B" & g & ":d" & g).Interior.ColorIndex = 6
Set BUL = Range("IQ:IQ").Find(Cells(g, 250))
If Not BUL Is Nothing Then
Cells(g, 4).Value = Cells(BUL.Row, "H").Value
End If
Else
Range("B" & g & ":d" & g).Interior.ColorIndex = 55
End If
If WorksheetFunction.CountIf(Range("Ip:Ip"), Cells(g, 251)) > 0 Then
Range("F" & g & ":H" & g).Interior.ColorIndex = 6
Else
Range("F" & g & ":H" & g).Interior.ColorIndex = 4
End If
Next
End Sub
 

Ekli dosyalar

sn fedeal size ne kadar teşekkür etsem azdır bu benim için çok önemliydi bu forumda herkese yardımcı oluyorsunuz karşılık beklemeden çok teşekkür ederim.
 
Ricaederim işinize yaradıgına sevindim,iyi çalışmalar.
 
sn fedeal hocam formülle denedim ama çözüm bulamadım. en son yapmış olduğun çalışmadaki değer verilmiş hücreleri kolaylık olması açısından 1 listedeki sarı dolgulu isimleri kitap 2 ye otomatik olarak aktarılabilirmi. .Ekte gösterdim sn hocam.


Private Sub makro1()
Range("A4").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Range("B4:D35").Select
Selection.Copy
Sheets("Sayfa2").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B7").Select
Sheets("Sayfa1").Select
Application.CutCopyMode = False
Range("A4").Select
Selection.AutoFilter
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Rows("5:30").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A4").Select
Sheets("Sayfa2").Select
End Sub
Genişletmek için tıkla ...

hocam bu kodu denedim ama hata verdi
 

Ekli dosyalar

Son düzenleme:
dosya ekte;

Kod: 
Private Sub CommandButton1_Click()
   Range("IP1:IQ65000").ClearContents
For i = 5 To Range("b65536").End(xlUp).Row
Cells(i, 250).Value = Trim(Cells(i, 2).Value) & Trim(Cells(i, 3).Value)
Cells(i, 251).Value = Trim(Cells(i, 6).Value) & Trim(Cells(i, 7).Value)
Next
For g = 5 To Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("Iq:Iq"), Cells(g, 250)) > 0 Then
Range("B" & g & ":d" & g).Interior.ColorIndex = 6
Set BUL = Range("IQ:IQ").Find(Cells(g, 250))
If Not BUL Is Nothing Then
Cells(g, 4).Value = Cells(BUL.Row, "H").Value
son = Sheets("Sayfa2").Range("b65536").End(xlUp).Row + 1
Sheets("Sayfa2").Cells(son, 2).Value = Cells(g, 2).Value
Sheets("Sayfa2").Cells(son, 3).Value = Cells(g, 3).Value
Sheets("Sayfa2").Cells(son, 4).Value = Cells(g, 4).Value
End If
Else
Range("B" & g & ":d" & g).Interior.ColorIndex = 55
End If
If WorksheetFunction.CountIf(Range("Ip:Ip"), Cells(g, 251)) > 0 Then
Range("F" & g & ":H" & g).Interior.ColorIndex = 6
Else
Range("F" & g & ":H" & g).Interior.ColorIndex = 4
End If
Next
End Sub
 

Ekli dosyalar

Farklı sayfadakı iki listede aynı olanları bulma

merhaba,

ekli dosyada mart sayfasındaki N sutunundaki rakamların,sayfa2 deki E sutununda var olup olmadıgını, eğer var ise sayfa 2 de f sutununda var olanların belırtılmesını yok ise de olmayanların G sutununda belırtılmesını ıstıyorum.

yardımcı olurmusunuz
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst