mükerrer ile ilgili yardım

[rmzn422]

For x = [A65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a1:H1" & x), Cells(x, "C")) > 1 Then Rows(x).Interior.ColorIndex = 22 Else Rows(x).Interior.ColorIndex = 0
Next

selam arkadaşlar, çok çok az programlama bilmeme rağmen bu sitede gördüğüm bir kodu yukarıdaki şekilde değiştirmiştim, ve bu kod kısmen işimi görüyor. resimdede görüldüğü gibi "c" sütunundaki bir ismi başka bir hücreye girdiğimde önceki kaydı kırmızı ile işaretliyor,bu benim istediğim şey fakat sadece "C" sütunu ile sınırlı ,mesela sayfada başka bir yere "görev yeri" yazsam "B1" deki kaydı işaretlemiyor. sizden ricam kodu diğer sütunlarıda içine alacak şekilde değiştirmeniz. zahmet olmazsa birde kodu açıklarsanız,belki bende birşeyler öğrenirim

 

[prmts]

Kodu açıklamaya çalışayım siz değiştirirsiniz.


For x = [A65536].End(3).Row To 1 Step -1
*** üstteki satırla döngü kuruyoruz 3.sütunun son dolu hücresinden 1.satıra kadar.
yukarıdaki resimde 10. satır mesela 10-9-8... diye içindeki kodları her satıra uygulayacak.

If WorksheetFunction.CountIf(Range("a1:H1" & x), Cells(x, "C")) > 1 Then
***eğer say formülünün kod hali
a1 ile h x hücresi (x=10 ise h10) aralığında c10 hücresindeki değer sayısı 1den çoksa alttaki kodlar uygulansın

Rows(x).Interior.ColorIndex = 22
*** x satırı 22 kodlu renk yap

Else
Rows(x).Interior.ColorIndex = 0
***eğer yukardaki sorgu yanlışsa hücre dolgu rengini kaldır.


Next
***döngü sonu

Umarım açıklayıcı olmuştur.

 

[rmzn422]

Açıklama için çok teşekkür ederim ama ben beceremedim,diğer sutünları aynı döngüye mi dahil edeceğiz yoksa her sutün için ayrı döngü mü kuracağız.

kod yazıp yollarsanız sevinirim.

 

[nsertoglu]

Açıklama için çok teşekkür ederim ama ben beceremedim,diğer sutünları aynı döngüye mi dahil edeceğiz yoksa her sutün için ayrı döngü mü kuracağız.

kod yazıp yollarsanız sevinirim.

' Aşağıdaki kod ile A1 ile (örn) C1 arasındaki matriks bilgilerinin sayfanın
' herhangi bir hücresinde eşi bulunursa martiks satırı renklendirilecektir.
' sağlıklı düşünceler dilerim..

Sub çift_yakala()
'ns 25/07/2012
syf = ActiveSheet.Name
Cells(1, 1).Select
sonR = Selection.End(xlDown).Row
sonK = Selection.End(xlToRight).Column
Rows().Interior.ColorIndex = 0

rgbak = Cells(1, sonK + 1).Address & ":" & Cells(Rows.Count, Columns.Count).Address
rgARA = Cells(1, 1).Address & ":" & Cells(sonR, sonK).Address
' (a1 ile son kolon) arasındaki tüm matriks elemanlarını,
' Matriks kolonlarından sonraki kolonlarda ara
' ve bulunan matriks elemanın hücresini renklendir.

For k = 1 To sonK
For r = sonR To 1 Step -1
ara = Cells(r, k)

Set bul = Sheets(syf).Range(rgbak).Find(ara)
If Not bul Is Nothing Then
Application.Goto Sheets(syf).Range(bul.Address)
acR = ActiveCell.Row
acK = ActiveCell.Column
bly = Cells(acR, acK)
Set bl2 = Sheets(syf).Range(rgARA).Find(bly)
If Not bl2 Is Nothing Then
Application.Goto Sheets(syf).Range(bl2.Address)
ActiveCell.Interior.ColorIndex = 22
'Rows(r).Interior.ColorIndex = 22
Else
Rows(r).Interior.ColorIndex = 0
End If
Else
If ActiveCell.Interior.ColorIndex = 22 Then
ActiveCell.Interior.ColorIndex = 22
'if Rows(r).Interior.ColorIndex = 22 Then
'Rows(r).Interior.ColorIndex = 22
Else
ActiveCell.Interior.ColorIndex = 0
'Rows(r).Interior.ColorIndex = 0
End If
End If
Cells(1, 1).Select
Next r
Next k
End Sub

 

[rmzn422]

rgbak = Cells(1, sonK + 1).Address & ":" & Cells(Rows.Count, Columns.Count).Address

Bu satırda hata verdi