Bulduğu Hücrenin Altındaki Hücreyi Seçme

[Pirhatap]

Merhaba Arkadaşlar,

Elimde bi function var. Burada amacım bulduğu hücrenin bir altındaki hücreyi getirmesini sağlamak.

Bunu nasıl yapabilirim.

makro aşağıda

Function firma_ismi(bolge As Range)
On Error Resume Next
Dim dizi() As String
Dim hucre As Range
Dim adet As Integer
adet = 0
For Each hucre In bolge
If hucre.Value Like "* TL*" Then
adet = adet + 1
ReDim Preserve dizi(1 To adet)
dizi(adet) = hucre.Value
End If
Next hucre
firma_ismi = dizi(1)
For i = 2 To UBound(dizi)
firma_ismi = firma_ismi & " ; " & dizi(i)
Next i


End Function

yardımlarınızı rica ederim.

iyi akşamlar

 

[bilgiconline]

Hiç açıklayıcı olmadığı için sorayım dedim , en son çıktı verdiği hücrenin bir altındaki satıra mı çıktıyı kopyalamak istiyorsunuz ?

 

[Pirhatap]

Hiç açıklayıcı olmadığı için sorayım dedim , en son çıktı verdiği hücrenin bir altındaki satıra mı çıktıyı kopyalamak istiyorsunuz ?

şöyle ki şimdi A stununda içeriğinde * TL* olan hücreleri kopyalayıp sırasıyla arasına " ; " koyarak fonksiyonu yazdığım yere getiriyor.
Benim isteğim ise içeriğinde * TL* yazan hücreyi bulunca o hücreyi değil de bir altındaki hücreyi getirsin.

Örnek vermek Gerekirse.

149.99 TL
Ayakkabı
29.99 TL
Şapka

İşte hepsi A stünunda farklı farklı yaklaşık 1000 satırın içinde yer alıyor. Benim ihtiyacım olan şey fiyatın altındaki hücrede yazan ibare.

 

[bilgiconline]

Bulduğu hücre ne ise ona ;

Dim bulunanhucre as String


ActiveCell.Select
bulunanhucre = ActiveCell.Row

'Bir altındaki satır içinse

ActiveSheet.Range("A" & bulunanhucre + 1).Select

kodunu yazarsanız son bulduğu hücrenin bir altındaki satırı seçer.

 

[Pirhatap]

Bulduğu hücre ne ise ona ;

Dim bulunanhucre as String


ActiveCell.Select
bulunanhucre = ActiveCell.Row

'Bir altındaki satır içinse

ActiveSheet.Range("A" & bulunanhucre + 1).Select

kodunu yazarsanız son bulduğu hücrenin bir altındaki satırı seçer.

Olmadı. Amacım seçmesi değil.

şöyle bir şeyler var A stünunda;

Ali
Ahmet
B Firması
149.99 TL
Ayakkabı
39.99 TL
Şapka
hasan
boşluk
boşluk
19.99 TL
Terlik

Function firma_ismi(bolge As Range)
On Error Resume Next
Dim dizi() As String
Dim hucre As Range
Dim adet As Integer
adet = 0
For Each hucre In bolge
    If hucre.Value Like "* TL*" Then
        adet = adet + 1
        ReDim Preserve dizi(1 To adet)
        dizi(adet) = hucre.Value
    End If
Next hucre
firma_ismi = dizi(1)
For i = 2 To UBound(dizi)
    firma_ismi = firma_ismi & " ; " & dizi(i)
Next i
  
 
End Function

Ben bu kodu kaydedip herhangi boş bir hücreye =firma_ismi ( A1: A1000) yazdığımda bana o hücreye 149.99 TL ; 39.99 TL; 19.99 TL getiriyor. yani kod yazıldığı üzere doğru çalışıyor çünkü orada hücre value kısmına içerisinde "* TL*" yazan dediği için içeriğinde TL olan herşeyi formülü yazdığım hücreye getiriyor.
Ancak benim istediğim ise hücre içeriğinde TL yazanlar değil de onun bir altındaki hücreyi getirsin yani formülü yazdığımda Ayakkabı ; Şapka ; Terlik getirsin. bu mümkün mü?

Yardımınız için şimdiden çok teşekkür ederim.

 

[EmrExcel16]

Merhaba

dizi(adet) = hucre.Value

Satırını aşağıdaki gibi değiştirip deneyiniz .

dizi(adet) = hucre.Offset(1, 0).Value

 

[bilgiconline]

Evet şimdi açıklayıcı oldu , sadece ve sadece

If hucre.Value Like "* TL*" Then

satırını

If Not hucre.Value Like "* TL*" Then

yani NOT koyarak halledebilirsin.

 

[Pirhatap]

Merhaba

dizi(adet) = hucre.Value

Satırını aşağıdaki gibi değiştirip deneyiniz .

dizi(adet) = hucre.Offset(1, 0).Value

Ellerin dert görmesin çok teşekkür ederim.

 

[Pirhatap]

Evet şimdi açıklayıcı oldu , sadece ve sadece

If hucre.Value Like "* TL*" Then

satırını

If Not hucre.Value Like "* TL*" Then

yani NOT koyarak halledebilirsin.

Yardımların için çok teşekkür ederim. cok saol.

 

[EmrExcel16]

Ellerin dert görmesin çok teşekkür ederim.

Rica ederim iyi çalismalar.