Excelde hücre aratmak bulduğu hücre karışına değer yazdırmak..

[aurer]

Merhaba Arkadaşlar,

Excelde bir dizin içinde bir hücre aratıp bulunan dizinin yanındaki hücreye aktif yazdırmak istiyorum. bu konuda bana yardımcı olursanız çok sevinirim. herkese kolay gelsin..

 

[leumruk]

Merhaba,

Sub Bul()
If Activecell.column<>3 Then Exit Sub
    Set c = Range("b1:b" & [b65536].End(3).Row).Find(ActiveCell, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
        Cells(c.Row, "d") = "AKTİF"
        Set c = Range("b1:b" & [b65536].End(3).Row).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End Sub

C sütununda seçili olan hücreyi B sütununda arar. Eğer hepsini birden aratmak istiyorsanız döngü oluşturmamız gerekli.

 

[Orion1]

C sütununda yazılı olan tüm değerleri b sütununda sorgular ve buldukalrının karşısına AKTİF yazar.

Sub aktif()
Dim i As Long, k As Range, adr As String, sat As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("D1:D65536").Clear
sat = Cells(65536, "B").End(xlUp).Row
For i = 1 To Cells(65536, "C").End(xlUp).Row
    Set k = Range("B1:B" & sat) _
    .Find(Cells(i, "C").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            k.Offset(0, 2).Value = "AKTİF"
            Set k = Range("B1:B" & sat).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
    Set k = Nothing
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır.", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[aurer]

yardımın için teşekkür ederim. ellerine emeğine sağlık. kolay gelsin..