iki farklı listedeki ortak verileri içeren satırı boyamak

Katılım
21 Mayıs 2010
Mesajlar
86
Excel Vers. ve Dili
2003 xls
Arkadaşlar merhaba. İki farklı sayfada verilerin olduğu listelerim var. Yapmak istediğim ikinci listede olan verilere sahip olan ilk sayfadaki satırları boyamak istiyorum. Mantığını kuramadım. Yani eğer sayfa ikinin a1 hücresindeki veri sayfa1 deki A:A da mevcutsa mevcut olduğu satır boyansın, sayfa ikinin a2 hücresindeki veri sayfa1 deki A:A da mevcutsa mevcut olduğu satır boyansın gibi. Basit bir örnek dosyada ekledim. Şimdiden ilginize teşekkür ediyorum.
 

Ekli dosyalar

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
Basit bir örnek dosyada ekledim.
Merhaba,
Bence dosyanız biraz fazla basit olmuş ;). Dosyanız tamamen boş.
Bir de bu işlemi koşullu biçimlendirme ile kolayca yapabilirsiniz. Yine de makro ile mi çözüm istiyorsunuz yoksa koşullu biçimlendirme de olur mu?
 
Katılım
21 Mayıs 2010
Mesajlar
86
Excel Vers. ve Dili
2003 xls
makroyla çözmek istiyorum orjinal dosya 15 mb falan :) ömer bey işin aslı yapmak istediğim şey tam olarak bu. İki sayfadaki A sütunlarını karşılaştırıp sayfa 1 de ki aynı veri olan satırları boyamak. Bu yüzden olayı çok dallandırıp budaklandırmadan çok basit bir şekilde dosya ekledim :) Hızlı cevabınız için teşekkür ediyorum.
 

Ekli dosyalar

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
Tekrar merhaba,
Aşağıdaki kodu deneyiniz.
PHP:
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Long
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Range("A:C").Interior.ColorIndex = 0
For a = 2 To s1.Cells(Rows.Count, "A").End(3).Row
    If WorksheetFunction.CountIf(s2.Range("A:A"), s1.Cells(a, "A")) > 0 Then
        s1.Range(s1.Cells(a, "A"), s1.Cells(a, "C")).Interior.ColorIndex = 3
    End If
Next
End Sub
 
Katılım
21 Mayıs 2010
Mesajlar
86
Excel Vers. ve Dili
2003 xls
çok teşekkür ediyorum. Gayet güzel çalışıyor kendi listeme uyarladım hiç sorun yaşamadım ilginize minnettarım
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
Rica ederim, yardımcı olabildiysem ne mutlu. İyi çalışmalar...
 
Katılım
21 Mayıs 2010
Mesajlar
86
Excel Vers. ve Dili
2003 xls
Ömer bey sizi tekrar rahatsız ediyorum. Şimdi listeyi bu şekilde gayet güzel boyadık lakin


Kod:
Function RenkSay(Rng As Range, RngColor As Range) As Integer
Dim Cll As Range
Dim Clr As Long
Clr = RngColor.Interior.Color
For Each Cll In Rng
If Cll.Interior.Color = Clr Then
RenkSay = RenkSay + 1
End If
Next Cll
End Function
bu kodlarla boyalı hücreleri saydırıyorum ve textbox a yazdırıyorum. Listeyi yenilediğimde dolu hücreleri saymıyor hücreye gelip enter ladığımda sayıyor. Yani hücreyi yenilemeden doğru sonucu vermek yerine eski değerde kalıyor. Bu sorunu nasıl çözebilirim. Bu arada sizin hücre rengini sarı yapmıştım.

Kod:
s1.Range(s1.Cells(a, "A"), s1.Cells(a, "O")).Interior.ColorIndex = 6
Dolu hücre saydırmayı fonksyon yerine direk kod ile yaptırabilir miyiz ? Mesela sarı renktekileri sayıp textboxa yazdırabilir miyiz ?
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
Renkli hücreleri ayrıca saydırmak yerine diğer koda sayma ilave etsek daha kolay olmaz mı? Tek seferde hallolur.
Rich (BB code):
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Long, say As Long
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Range("A:C").Interior.ColorIndex = 0
For a = 2 To s1.Cells(Rows.Count, "A").End(3).Row
    If WorksheetFunction.CountIf(s2.Range("A:A"), s1.Cells(a, "A")) > 0 Then
        s1.Range(s1.Cells(a, "A"), s1.Cells(a, "C")).Interior.ColorIndex = 6
        say = say + 1
    End If
Next
Textbox1 = say
End Sub
 
Katılım
21 Mayıs 2010
Mesajlar
86
Excel Vers. ve Dili
2003 xls
Cok tesekkur ederim tam istedigim formata kavustu elleriniz dert gormesin ( is yogunlugundan dolayi foruma girememistim gec cevabim icin kusura bakmayin )
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
Rica ederim, iyi çalışmalar...
 
Üst