Sayfa 2 den sayfa 1 e veri alma

[alkandiren]

Merhaba,

sayfa 2
A B C D
1 meyva elma armut portakal
2 sebze patlıcan pırasa patates
3 çerez fındık fıstık leblebi


istiyorum ki sayfa 1 de A sütununda herhangi bir satıra sayfa 2 nin A sütünundaki bir sözcüğü yazdığımda sayfa 1 in B C D sütunlarına sayfa 2 nin o sözcüğün B C D sütunları gelsin

yani sayfa 1 de A sütununa meyva yazdığımda karşısına elma armut portakal gelmesini istiyorum. bunu eğer ile yaparım ama 1000 satır olucak böyle o yüzden zor olur ben makroyla vbasicle yapmak istiyorum denedim birşeyler ama bütün satırlar için geçerli olmadı.

yardımcı olursanız sevinirim
teşekkürler

 

[Necdet]

Merhaba,

Forumda DÜŞEYARA yazın ve aratın.

 

[dEdE]

...ben makroyla vbasicle yapmak istiyorum denedim birşeyler ama bütün satırlar için geçerli olmadı...

Merhaba,
Forumumuza Hoşgeldiniz.
Aşağıdaki kodları Sayfa1 in kod sayfasına yapıştırın. Sayfa1 in A sütununa Sayfa 2 nin A sütünundaki bir sözcüğü yazdıp entere bastığınızda çalışır. İyi çalışmalar.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
satır = ActiveCell.Row - 1
If satır = 1 Then satır = 1

For i = 1 To Sheets(2).[A65536].End(3).Row
    If Sheets(1).Cells(satır, 1).Value = Sheets(2).Cells(i, 1).Value Then
    Sheets(1).Range("B" & satır & ":D" & satır).Value = Sheets(2).Range("B" & i & ":D" & i).Value
    End If
Next

End Sub

 

[alkandiren]

@dEdE
istediğim tam olarak buydu Çok teşekkürler
bu koddaki özellikler ve metodları araştırıp öğrenmeye çalışacağım.
Necdet Bey Düşeyara fonksiyonunu da öğreneyim belki pratikte kullanmak gerekebilir
ilginize teşekkürler
başarılar herkese...

 

[dEdE]

Rica ederim.
Çalışmalarınızda başarılar dilerim.

 

[Necdet]

Merhaba,

Gözümden kaçmış Makro ile çözüm istemişsiniz. Sayın dEdE'nin çözümüne karşılık alternatif olsun.

Not :

• Döngü ile arattırmak büyük satırlı dosyalarda zaman kaybına neden olur, Find komutu daha hızlı çalışır.
• İlk Satırdaki Option Compare Text, Büyük-Küçük harf duyarlılığını ortadan kaldırır.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Set s2 = Sheets("Sayfa2")
With s2.Range("A:A")
    Set Bul = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
        Target.Offset(0, 1) = s2.Cells(Bul.Row, "B")
        Target.Offset(0, 2) = s2.Cells(Bul.Row, "C")
        Target.Offset(0, 3) = s2.Cells(Bul.Row, "D")
    Else
        Target.Offset(0, 1) = "#YOK"
        Target.Offset(0, 2) = "#YOK"
        Target.Offset(0, 3) = "#YOK"
    End If
End With
Son:
End Sub

 

[dEdE]

Merhaba,
Sayın Yeşertener.

Döngü ile arattırmak büyük satırlı dosyalarda zaman kaybına neden olur, Find komutu daha hızlı çalışır.

Bunu bilmiyordum. Forumda biraz araştırdım. Find komutunun farklı kullanımları var. Bu komut ile ilgili detaylı açıklama (varsa parametreleri ve özellikleri) yapabilmeniz mümkün müdür?

Saygılar.

 

[alkandiren]

teşekkürler,
bu kodlardaki komutları öğrenebileceğimiz net üzerinde türkçe kaynak var mı?

 

[Necdet]

Sayın dEdE,

Bende ilk defa Korhan beyden görmüştüm, sonra VBA nın yardımında verilen örnekleri inceleyerek birşeyler öğrenmeye başladım.

Yardım menüsü gerçekten çok yararlı oluyor, incelemenizi öneririm.

Verdiğim kodda LookAt:=xlWhole seçeneği tam sözcük eşleştirmesi yapar, bunu kullanmazsak sözcük içinden bir parçayı bile arattırmış olursunuz ki gerçekten çok güzel bir özelliktir.

Örneğin kara dediğinizde Ankara'yı da getirmesi gibi.

 

[alkandiren]

merhaba
bir sorum daha olucak bu konuyla ilgili
ben aynı sayfada başka bir kolonda, başka bir satırda birşey yazdığım zaman da başka sayfadan alacağım veriler var bunun icin ayrı sublar tanımlayabilir miyim?
Worksheet_change subını 1 kez kullanabiliyoruz
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub bunu sildiğim zaman sayfa kilitleniyor, silmediğim zaman başka kolon,satırlar için yazdığım kodlar çalışmıyor
teşekkürler

 

[dEdE]

Merhaba,
Anahtar sözcük Target, [A:A] Aşağıda Target komutunun farklı kullanımlarına örnekler var. Umarım işinize yarar.

If Intersect(Target, [B3:Q1502]) Is Nothing Then Exit Sub
If Intersect(Target, [C:C, F:F]) Is Nothing Then Exit Sub

 

[dEdE]

Teşekkürler Sayın Yeşertener,

Yardım menüsü gerçekten çok yararlı oluyor, incelemenizi öneririm.

Bu konuda haklısınız. Ben de zaman zaman bakarım yardım menüsüne. Ancak İngilizce konusunda pek iyi değilim. Açıklamaların çoğunu anlamıyorum. Yine de işe yarıyor.

Hoşçakalın.

 

[alkandiren]

teşekkürler,
ben de şöyle çözmüştüm
If Target.Column=4 Then
---
End If

If Target.Row>=2 Then
----
End If
Şeklinde

Verdiğiniz örnekleri de aldım arşive

Sizin ve Necdet Beyin verdiği kodlardan yola çıkarak şaka maka baya gelişme kaydettim 2 günde
Sağolun
Başarılar...

 

[dEdE]

Rica ederim.
Güle güle kullanın.

 

[xlsx]

Merhaba,

Gözümden kaçmış Makro ile çözüm istemişsiniz. Sayın dEdE'nin çözümüne karşılık alternatif olsun.

Not :

• Döngü ile arattırmak büyük satırlı dosyalarda zaman kaybına neden olur, Find komutu daha hızlı çalışır.
• İlk Satırdaki Option Compare Text, Büyük-Küçük harf duyarlılığını ortadan kaldırır.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Set s2 = Sheets("Sayfa2")
With s2.Range("A:A")
    Set Bul = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
        Target.Offset(0, 1) = s2.Cells(Bul.Row, "B")
        Target.Offset(0, 2) = s2.Cells(Bul.Row, "C")
        Target.Offset(0, 3) = s2.Cells(Bul.Row, "D")
    Else
        Target.Offset(0, 1) = "#YOK"
        Target.Offset(0, 2) = "#YOK"
        Target.Offset(0, 3) = "#YOK"
    End If
End With
Son:
End Sub

Sn Yeşertener, bu kodlarda nasıl bir ekleme yapabiliriz? copy paste yapıldığında da otomatik olarak bulma işlemi gerçekleşsin.Bu kodlarda sadece A sütununda yazılıp enter'a basılınca bulma işllemi gerçekleşiyor ama kopyaladığımız birden fazla veriyi A sütununa yapıştırınca bulma işlemi eksik oluyor.