Makro ile düşey arama

[Farklı]

Ekteki dosyada görüleceği üzere,
01 Sayfasında A sütünuna girdiğim değeri, İCMAL Sayfasında S.NO nu referans alarak "Ad Soyad" ve "Görevi" değerlerini çekmem gerekiyor

veriyi çekeceğim sayfalar 01,02,03........ 31 adlı sayfalar şeklinde ayın her günü içindir.

Şuanda ekte görüleceği üzere formülle bu işi yapıyorum bilgisayarı acayip kasıyor.

 

[YUSUF44]

Aşağıdaki gibi kullanabilirsiniz:

=EĞERHATA(DÜŞEYARA($A3;DOLAYLI("'"&METNEÇEVİR(İCMAL!F$2;"gg")&"'!A:V");10;0);0)

 

[Farklı]

Aşağıdaki gibi kullanabilirsiniz:

=EĞERHATA(DÜŞEYARA($A3;DOLAYLI("'"&METNEÇEVİR(İCMAL!F$2;"gg")&"'!A:V");10;0);0)

zaten şuanki halinde düşeyarayla işlem gercekleşiyor, amacım hücreleri formullerden kurtarıp makroyla yazmak dosyanın kasmasını engelleyebilmek

 

[Farklı]

=EĞERHATA(DÜŞEYARA(A117;İCMAL!$A:$D;4;0);"")

Bu şekliyle üsteki formulü kullanıyordum bunu makro kodlarıyla yapmalıyım =!

 

[Necdet]

Merhaba,

Aşağıdaki kodları "BuÇalışmaKitabı" nın kod bölümüne kopyalayıp dener misiniz.

Sıkıntılar çıkabilir sanırım sayfanızda aynı işlemi tüm sütunlarda yapmıyorsunuz.

Gördüğüm kadarıyla sayfadaki değişiklik eğer 117. satırdan küçükse kodlar çalışmasın dedim. Gerekirse buradaki mantığı siz kendinize daha uygun hale getirebilirsiniz.

Birleştirilen hücrelerde de sıkıntı çıkabilir o yüzden offset yerine Range kullanmak zorunda kalarak kodları biraz uzatmış oldum.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    Dim c As Range
    
    If ActiveSheet.Name = "İCMAL" Or Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    
    If Target.Row < 117 Then Exit Sub
    
    If IsNumeric(Target.Offset(0, -1)) = False Then Exit Sub
    If Target.Value = "" Then
        Range("E" & Target.Row).ClearContents
        Exit Sub
    End If
    
    
    Set c = Sheets("İCMAL").Range("D:D").Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Range("E" & Target.Row) = c.Offset(0, 1).Value
    Else
        Range("E" & Target.Row).ClearContents
    End If
    
End Sub

 

[Farklı]

Merhaba,

Aşağıdaki kodları "BuÇalışmaKitabı" nın kod bölümüne kopyalayıp dener misiniz.

Sıkıntılar çıkabilir sanırım sayfanızda aynı işlemi tüm sütunlarda yapmıyorsunuz.

Gördüğüm kadarıyla sayfadaki değişiklik eğer 117. satırdan küçükse kodlar çalışmasın dedim. Gerekirse buradaki mantığı siz kendinize daha uygun hale getirebilirsiniz.

Birleştirilen hücrelerde de sıkıntı çıkabilir o yüzden offset yerine Range kullanmak zorunda kalarak kodları biraz uzatmış oldum.

http://s1307.hizliresim.com/1c/9/q1uhj.jpg resimdeki hatayı alıyorum.
istediğim koda ek olarak A sutununa değeri girdiğimde makronun kendisinin çalışmasını sağlamak mümkünmüdür =?

 

[mancubus]

böyle de çalışır ama eğer VBA'den yararlanacaksanız, necdet bey'in de dediği gibi, merged cell (birleştirilmiş hücre) kullanmaktan ısrarla, katiyetle, defaatle kaçının...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Sh.Name = "İCMAL" Then Exit Sub 'icmal dışındaki tüm sayfalarda çalış
    If Target.Column <> 1 Then Exit Sub 'sadece A sütununa veri girildiğinde çalış
    
    With Worksheets("İCMAL")
        arr = .Range("A3:E" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    
    With Application
        If IsError(.Match(Target.Value, .Index(arr, , 1), 0)) Then
            MsgBox "Hatalı giriş!"
            Exit Sub
        End If
        Target.Offset(, 2).Value = .Index(arr, .Match(Target.Value, .Index(arr, , 1), 0), 4)
        Target.Offset(, 4).Value = .Index(arr, .Match(Target.Value, .Index(arr, , 1), 0), 5)
    End With

End Sub