Düşeyara ile kaynak biçimlendirmeyi koruyarak veri alma?

[tigiy]

Herkese merhaba,

Arkadaşlar benim bir problemim var. Düşey ara ya da indis kaçıncı formülü ile istediğim verileri bulabiliyorum ancak şöyle bir ihtiyaç ortaya çıktı. Ben düşeyara ya da indis kaçıncı formüllerini kullandığında gelen veri kaynak biçimlendirmesini koruyarak gelmesini istiyorum. Bunu nasıl sağlarım?

Şimdiden yardımlarınız için teşekkürler

Saygılarımla

 

[turist]

Örnek dosyanızı ekleyip, istediğinizi dosya üzerinde açıklarsanız; yanıt almanız daha kolay olacaktır.

 

[tigiy]

Haklısınız hocam örneği ekledim.

 

[turist]

İstediğiniz şeyi, yerleşik Excel formülleri ile yapmak mümkün değil.
Ancak; makro uygulaması ile yapılabilir.

 

[tigiy]

hocam örnek üzerinde bir uygulama yapabilir misiniz?

 

[Korhan Ayhan]

Merhaba,

Çalışmanıza boş bir modül ekleyin ve aşağıdaki kodu uygulayın.

Modül eklemek için ALT+F11 penceresinden INSERT menüsünü açın ve MODULE seçeneğini seçin.


Daha sonra kodu çalıştırıp sonucu gözlemleyin.

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, X As Long, BUL As Range
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("ANASAYFA")
    Set S2 = Sheets("SORU")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    S1.Range("B:B").Clear
    
    For X = 1 To Son
        If S1.Cells(X, 1) <> "" Then
            Set BUL = S2.Range("A:A").Find(S1.Cells(X, 1), , xlValues, xlWhole)
            If Not BUL Is Nothing Then
                BUL.Offset(0, 2).Copy S1.Cells(X, 2)
            End If
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tigiy]

Korhan bey öncelikle yardımınız için teşekkürler. örnek için evet bu iş görüyor ancak daha karışık tablolarda işimi görmüyor malesef ben belirli aralıklarda veri almak istiyorum sizin verdiğiniz makro ne var ne yok alıyor hepsini. Ben düşeyaranın hücre biçimlendirmesini koruyarak veri bulanını istiyorum aslına bakarsanız. Eğer bunu kullanıcı tanımlı fonkisyon ile yapabilirsek benim için daha işlevsel olacaktır.

Saygılarımla

 

[Korhan Ayhan]

Fonksiyonla biçim aktaramazsınız...

Önerdiğim kodları önerilerinizle daha kullanışlı hale getirebiliriz.

 

[tigiy]

Korhan bey siz önerdiğiniz kodu adım adım anlatırsanız belki istediğim şekle çevirebilirim

özellikle

Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
S1.Range("B:B").Clear

For X = 1 To Son
If S1.Cells(X, 1) <> "" Then
Set BUL = S2.Range("A:A").Find(S1.Cells(X, 1), , xlValues, xlWhole)
If Not BUL Is Nothing Then
BUL.Offset(0, 2).Copy S1.Cells(X, 2)
End If

bu bölümü

 

[Korhan Ayhan]

ANASAYFA isimli sayfanızın "A" sütunundaki verileri döngü ile SORU sayfanızın "A" sütununda arayarak buluyor. Bulduğu satırın yan sütunundaki hücreyi kopyala-yapıştır ile ANASAYFA'ya aktarıyor.

 

[tigiy]

Bulduğu satırın yan sütunundaki hücreyi değilde bir yanındaki nasıl kopyala-yapıştır ile ANASAYFA'ya alabilirim. Ayrıca verilerin sonunda kadar değilde örneğin a16 dan a35 ekadar olanları nasıl bu yönetem ile alabilir

 

[Korhan Ayhan]

Aşağıdaki bölümdeki 2 değeri ile oynayarak istediğiniz sütundaki bilgiyi alabilirsiniz.

BUL.Offset(0, 2)

A16-A35 arası içinse döngüyü aşağıdaki gibi başlatın.

For X = 16 To 35

 

[tigiy]

Şimdi çözdüm korhan bey teşekkürler. Kodu biraz daha ilerletip sorun olan yerlerde size burdan dönüş yapabilirim yine cevaplarsanız çok memnun olurum.

Saygılarımla