Düşeyara fonksiyonu

[ergaruda]

Arkadaşlar düşeyara formülü kullanarak bulunan verilerde eğer tablo içerisinde aranan değer birden fazla ise karşılığındaki farklı veriler aynı hücreye nasıl eklenebilir

 

[Ömer]

Merhaba,

Aynı hücreye yazmak için makro gerekir. Alt alta yazmak için aşağıdaki yolu izleyin.

Örnek:

=DÜŞEYARA(E1;A1:B10;2;0) formüldeki gibi. Aranan değer E1, aradığınız aralık A1:A10, sonuç sütunu B1:B10 olsun.

Formülü uyguladığınız hücre G1 ve alt satırları olsun.

Aşağıdaki formülü G1 hücresine yazıp dizi formülüne çevirdikten sonra alt satırlara kopyalayın. Aynı mantıkla aralıkları kendi dosyanıza uyarlarsınız.

=EĞERHATA(İNDİS($B$1:$B$10
 ;KÜÇÜK(EĞER($A$1:$A$10=$E$1
  ;SATIR($A$1:$A$10)-SATIR($A$1)+1);SATIRSAY($G$1:G1)));"")

Dizi formülleri hücreye girildikten sonra entera basılmadan ctrl + shift + enter tuş kombinasyonu ile girişi tamamlanır. Bu işlemden sonra formülün başına ve sonun { } ayıraçları otomatik eklenir

Not: Formülü uyguladıktan sonra yinede alt alta değilde, aynı hücrede olmasını isterseniz belirtiniz. Makro düzenlemesi yaparım.

.

 

[ergaruda]

Çok teşekkür ederim Hocam.

 

[Ömer]

İstek üzerine.
Aynı hücrede yazmak için.

E1 deki değeri A sütununda arar, B sütunundaki karşılığını G1 hücresine araya "|" ayracını koyarak yazar.

Sub Aranan_Bul()
    
    Dim c As Range, Adr As String, ayr As String
    
    ayr = "|" 'listelemede arada kullanılan ayraç
              'boşluk için " " yeterli.
    
    With Range("G1") 'verinin yazılacağı hücre
        .ClearContents
        Set c = [[COLOR="Red"]A:A[/COLOR]].Find([[COLOR="Teal"]E1[/COLOR]], , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                .Value = .Value & ayr & Cells(c.Row, "[COLOR="blue"]B[/COLOR]")
                Set c = [[COLOR="red"]A:A[/COLOR]].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        .Value = WorksheetFunction.Substitute(.Value, ayr, "", 1)
    End With
    
End Sub

.

 

[ergaruda]

Teşekkürler

 

[ergaruda]

İstek üzerine.
Aynı hücrede yazmak için.

E1 deki değeri A sütununda arar, B sütunundaki karşılığını G1 hücresine araya "|" ayracını koyarak yazar.

Sub Aranan_Bul()
    
    Dim c As Range, Adr As String, ayr As String
    
    ayr = "|" 'listelemede arada kullanılan ayraç
              'boşluk için " " yeterli.
    
    With Range("G1") 'verinin yazılacağı hücre
        .ClearContents
        Set c = [[COLOR="Red"]A:A[/COLOR]].Find([[COLOR="Teal"]E1[/COLOR]], , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                .Value = .Value & ayr & Cells(c.Row, "[COLOR="blue"]B[/COLOR]")
                Set c = [[COLOR="red"]A:A[/COLOR]].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        .Value = WorksheetFunction.Substitute(.Value, ayr, "", 1)
    End With
    
End Sub

.

bu makro işe yaradı ancak döngüsel olarak yapmam gerekiyor. arama yapılan hücre bir tane olmayacak sırayla belki 100lerce satır olacak bunu nasıl yapabilirim.

 

[antonio]

bu makro işe yaradı ancak döngüsel olarak yapmam gerekiyor. arama yapılan hücre bir tane olmayacak sırayla belki 100lerce satır olacak bunu nasıl yapabilirim.

Merhaba,
Söyledikleriniz doğrultusunda 40-50 satırlık örnek bir dosya eklerseniz, yardım alma şansınız daha yüksek olur.

 

[ergaruda]

ÖRNEK

merhaba,
söyledikleriniz doğrultusunda 40-50 satırlık örnek bir dosya eklerseniz, yardım alma şansınız daha yüksek olur.

dosya ekleyemedim ama şöyle örneklesem:

4601 peynir-çilek-elma-ayva-armut-biber
4654
4628
5218
4265
2218
5466
2265

burada yukarıda verilen makro sadece ilk satıra uygulanabiliyor. Diğerleri boş kalıyo

 

[ergaruda]

bu konuda yardımcı olacak bir arkadaş var mı acaba

 

[Ömer]

Sorunuz net değil.

Küçük bir örnek dosya hazırlayıp, yapmak istediğinizi detaylı açıklayarak paylaşım sitesine ekleyerek linki paylaşınız.

www.dosya.tc

.

 

[ergaruda]

http://dosya.co/7mbk87cbdya8/çalışma.xlsm.html

ÖRNEK DOSYA, ALT SATIRLARA DA UYGULANMASI GEREKİRKEN SADECE ÜST SATIRDA KALIYOR

 

[Ömer]

Bu şekilde deneyin.

Sub Rapor_Al()

    Dim i As Long, c As Range, Adr As String, ayr As String

    Application.ScreenUpdating = False
    Range("E:G").ClearContents

    Columns("A:A").Copy Range("E1")
    ActiveSheet.Range("E1:E" & Cells(Rows.Count, "A").End(xlUp).Row) _
        .RemoveDuplicates Columns:=1, Header:=xlNo
    
    ayr = "-" 'listelemede arada kullanılan ayraç
              'boşluk için " " yeterli.
    
    For i = 1 To Cells(Rows.Count, "E").End(xlUp).Row
        Set c = [A:A].Find(Cells(i, "E"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Cells(i, "F") = Cells(i, "F") & ayr & Cells(c.Row, "B")
                Cells(i, "G") = Cells(i, "G") & ayr & Cells(c.Row, "C")
                Set c = [A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        Cells(i, "F") = WorksheetFunction.Substitute(Cells(i, "F"), ayr, "", 1)
        Cells(i, "G") = WorksheetFunction.Substitute(Cells(i, "G"), ayr, "", 1)
    Next i

    Application.ScreenUpdating = True
    
End Sub

.

 

[ergaruda]

Teşekkürler bu sefer tamı tamına oldu ellerine sağlık