Makroya disaridan Range degeri girilebilir mi?

[korfez]

Arkadaslar,

Asagida yer alan makroda A1:A10 bolgesindeki hucreler ile B1:B10 bolgesindeki hucreler birbirleriyle kiyaslaniyor ve ayni olanlar isaretleniyor.

---------------------------------------------------------------
Sub SutunKiyasla()

Dim HUCRE1, HUCRE2 As Range

For Each HUCRE1 In Worksheets("Sayfa1").Range("A1:A10")
For Each HUCRE2 In Worksheets("Sayfa1").Range("B1:B10")
If HUCRE1 = HUCRE2 Then
HUCRE1.Interior.ColorIndex = 15
HUCRE2.Interior.ColorIndex = 15
End If
Next HUCRE2
Next HUCRE1

End Sub
---------------------------------------------------------------
Dikkat ederseniz A1:A10 ile B1:B10 bolgeleri makro icinde tanimlandigi icin baska bolgeler icin bu makroyu kullanmak istedigimizde her seferinde makroya mudahale edip yeni bolge tanimlamalari yapmamiz gerekiyor.

Bunun yerine, bu bolgeler bir degisken olarak makroda yer alsa ve biz calisma sayfasinda ilgili bolgeleri mouse ile tarayarak veya bolge degerlerini girerek (InputBox'a benzer bir komut ile) makroyu calistirabilir miyiz? Ilginize simdiden cok tesekkur ederim.

M.D

 

[xxcell]

Aslında mouse ile seçerek seçtiğiniz hücreleri karşılaştıran bir kod yazılabilir ama Inputbox baya bi kolayıma geldi ona uygun örnek hazırladım.

Sub SutunKiyasla()
On Error GoTo hata:
Dim HUCRE1, HUCRE2 As Range

Alan1 = InputBox("1.Alan")
Alan2 = InputBox("2.Alan")


For Each HUCRE1 In Range(Alan1)
For Each HUCRE2 In Range(Alan2)
If HUCRE1 = HUCRE2 Then
HUCRE1.Interior.ColorIndex = 15
HUCRE2.Interior.ColorIndex = 15
End If
Next HUCRE2
Next HUCRE1

Exit Sub

hata:
MsgBox "Hata oluştu, muhtemelen alan girdileri yanlış"

End Sub

 

[veyselemre]

Inputboxlarda mouse kullanabilirsiniz.

Sub SutunKiyasla()

Dim HUCRE1, HUCRE2 As Range
    Set alan1 = Application.InputBox(prompt:="1.Aralık Seçiniz.", Title:="Seçim", Default:=Selection.Address, Type:=8)
    Set alan2 = Application.InputBox(prompt:="2.Aralık Seçiniz.", Title:="Seçim", Type:=8)
If alan1 Is Nothing Or alan2 Is Nothing Then Exit Sub
    For Each HUCRE1 In alan1
        For Each HUCRE2 In alan2
            If HUCRE1 = HUCRE2 Then
                HUCRE1.Interior.ColorIndex = 15
                HUCRE2.Interior.ColorIndex = 15
            End If
        Next HUCRE2
    Next HUCRE1
Set alan1 = Nothing
Set alan2 = Nothing
End Sub

 

[korfez]

Elle deger girme konusunda Sn. xxcell'e, mause ile alan taramasi yaparak deger girme konusunda da Sn. veyselemre'ye ayri ayri tesekkurlerimi sunuyorum.

Yine burada paylasilan kodlar yardimiyla, bir cok kisinin isine yarayacagini umdugum bir calismada bu kodlari kullanacagim ve bahsi gecen calismayi da en kisa zamanda burada sizlerle paylasacagim. Hepinize iyi gunler...
M.D