Düşey ara fonksiyonunun kod ile yapılması

[yst10]

Selamlar,
Soru, başlıktaki gibi, mesela,
=DÜŞEYARA($B8;SABLON!$A$2:E$65536;SÜTUNSAY($B$2:E$8);0)
formülünün b8 den b200 e kadar işlem yapması için, nasıl bir kod yazılması gerekir?
Çok teşekkür ederim, iyi çalışmalar.
Yavuz Tümer

 

[Orion1]

Aşağıdaki kodlar bulduğu değerleri C sütununa yazar.

Sub bul()
Dim i As Integer, k As Range
For i = 8 To 200
    Set k = Sheets("SABLON").Range("A2:A65536").Find(Range("B" & i).Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(i, "C").Value = k.Offset(0, 3).Value
    End If
    Set k = Nothing
Next i
MsgBox "İşlem tamamlandı"
End Sub

 

[yst10]

Evren hocam, teşekkür ederim,
Kendi sayfama koydum olmadı, rica etsem bir örnek dosya ile öğretebilirmisin bana, sanırım bu saatte kafam basmadı, anlamamış olabilirim.
Sevgiler, iyi geceler.
Yavuz Tümer

 

[yst10]

Evren Bey,
Bugün tekrar baktım dosyada denedim yine olmadı.
Ekli dosyada sorun nedir, nerededir anlamadım.
İlgilenirseniz sevinirim.
İyi akşamlar.

 

[yst10]

Evren hocam,
Sorumu görmediniz sanırım, bekledim ama cevap olmayınca
bir kez daha hatırlatmak istedim.
Yavuz Tümer

 

[Orion1]

Dosyanız ekte.

Private Sub CommandButton1_Click()
Dim i As Integer, k As Range
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("B8:B65536").ClearContents
For i = 8 To 200
    Set k = Sheets("SABLON").Range("A2:A65536").Find(Range("A" & i).Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(i, "B").Value = k.Offset(0, 1).Value
    End If
    Set k = Nothing
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı"
End Sub

 

[yst10]

Evren bey, çok teşekkür ederim. Ellerinize sağlık, gayet güzel olmuş. Son bir soru, sablon sayfasındaki tabloda tekrar eden değerler olursa, ki zaten var ve bunların karşılıkları farklı olursa "mesela n7260 bir satırda 2 iken bir diğerinde 7 vs." ne yapabiliriz.
Saygılar.

 

[Orion1]

Evren bey, çok teşekkür ederim. Ellerinize sağlık, gayet güzel olmuş. Son bir soru, sablon sayfasındaki tabloda tekrar eden değerler olursa, ki zaten var ve bunların karşılıkları farklı olursa "mesela n7260 bir satırda 2 iken bir diğerinde 7 vs." ne yapabiliriz.
Saygılar.

Ne yapacağınıza siz karar vereceksiniz.

 

[yst10]

Ne yapacağınıza siz karar vereceksiniz.

Hocam, nasıl yapacağımı bilsem zaten sizlerin değerli vaktini almam. Verdiğiniz örnekte, bulduğu ilk n7260 değerini aktarıyor, aşağı doğru aramaya devam etmiyor. Ben sadece bunun devamlılığının nasıl olacağını sormuştum. ikinci n7260 ı bulduğunda da onun satırına denk gelen bilginin aktarılması...
İlginize teşekkür ederim.

 

[Orion1]

Ekli dosyayı inceleyiniz.

Private Sub CommandButton1_Click()
Dim i As Long, k As Range
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("B8:B65536").ClearContents
ReDim myarr(1 To 2, 1 To 1)
With CreateObject("Scripting.Dictionary")
     .CompareMode = vbTextCompare
     For Each k In Range("A8:A200")
       If Not .exists(k.Value) Then
            .Add k.Value, Nothing
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = k.Value
            myarr(2, a) = 2
        End If
     Next
End With
For Each k In Range("A8:A200")
    For i = 1 To UBound(myarr, 1)
        If k.Value = myarr(1, i) Then
            For t = myarr(2, i) To Sheets("SABLON").Cells(65536, "A").End(xlUp).Row
                If k.Value = Sheets("SABLON").Cells(t, "A").Value Then
                    k.Offset(0, 1).Value = Sheets("SABLON").Cells(t, "B").Value
                    myarr(2, i) = t + 1
                   GoTo atla
                End If
            Next t
        End If
    Next i
atla:
Next k
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı"
End Sub

 

[yst10]

Evren bey,
Ellerinize sağlık, gayet güzel çalışıyor.
Çok teşekkür ederim.
İyi çalışmalar.
Yavuz Tümer

 

[Orion1]

Evren bey,
Ellerinize sağlık, gayet güzel çalışıyor.
Çok teşekkür ederim.
İyi çalışmalar.
Yavuz Tümer

Rica ederim.
iyi çalışmalar.

 

[yst10]

Evren bey,
Kabak tadı vermeye başladığımın farkındayım ama, sanırım aranan kodlar değişince hatalı sonuç vermeye başladı. Dosya ekte, rica etsem bir bakabilirmisiniz.
Yavuz Tümer

 

[Orion1]

Evren bey,
Kabak tadı vermeye başladığımın farkındayım ama, sanırım aranan kodlar değişince hatalı sonuç vermeye başladı. Dosya ekte, rica etsem bir bakabilirmisiniz.
Yavuz Tümer

Gerekli değişikliği yaptım.
Ekli dosyayı inceleyiniz.

 

[yst10]

Evren bey,
Tekrar çok çok teşekkürler, gayet güzel çalışıyor.
İyi çalışmalar, kolay gelsin.
Hoşçakalın.
Yavuz Tümer

 

[Orion1]

Evren bey,
Tekrar çok çok teşekkürler, gayet güzel çalışıyor.
İyi çalışmalar, kolay gelsin.
Hoşçakalın.
Yavuz Tümer

Rica ederim.
İyi çalışmalar.

 

[bdemir27]

selam
sayfa3 de de aynı veriler olsaydı ve bu verilerin karşısındaki değerleri de c sütununa yeni bir buton sayesinde yazdırmak isteseydik kodda ne gibi değişiklik yapmamız gerekirdi
yardımlarınız için tşk.