Mükerrer Bulma Kod yardım

[Ali Kayhan ATAY]

Selamlar Arkadaşlar
Daha önce forumdaki abilerimizin yaptığı bir macro ile sıkıntı yaşıyorum. Amacım Mükerrer sayı/tutar/tarih/yazı bulmak fakat kodu çalıştırıken hata alıyorum excel dosyası olarak eklemem şuan mümkün değil şimdilik ekleyeceğim macroyu kontrol edebilriseniz sevinirim

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

 

[Ömer]

Merhaba,

Bu şekilde yapmak istediğinizi anlamak zor. Eski kodları hesaba katmadan, yapmak istediğinizi küçük bir örnek dosya ekleyerek açıklamanızı rica ederim. Eğer dosya ekleyemiyorsanız sorunuzu hücre adresleri vererek eski kodu hesaba katmadan detaylı olarak açıklayınız.

 

[Ali Kayhan ATAY]

Ömer Bey
İlginiz için teşekkür ederim , forumda yeteri aramayı yapmamışım.
Aradığımı forumdaki birkaç konuda buldum

Gerçi yine sizin çözümünüzmüş oda teşekkür ederim.