Şartlı veri çekme

[hknbsr]

Merhaba,
Sayfa1 A sütununda öğrenci tcleri var B sütununda Türkçe ders notları var. Sayfa2 de A sütununda da öğrenci tcleri B sütununda matematik notları var. Yapmak istediğim Sayfa1 ve Sayfa2 deki tcleri tarayıp aynı tcleri Sayfa3 A sütununa bir kere yazması Sayfa3 B sütununada bu öğrencinin Türkçe ve Matematik notunu birlikte arada virgülle yazması. Yardımlar için şimdiden teşekkürler

 

[hasankardas]

Merhaba,
Sayfa3 e a sütununa tc leri kopyalayıp
b sütuna

=DÜŞEYARA(A2;Sayfa1!A:B;2;YANLIŞ) & ", " & DÜŞEYARA(A2;Sayfa2!A:B;2;YANLIŞ)

bu formül ile notları aktarabilirsiniz.

 

[hknbsr]

Tcleri kendi çekmesi gerekiyor. Matematikte olan bazı tcler Türkçede yok. İkisinde ortak olanları bir tane olarak çekmesi gerekiyor

 

[ÖmerBey]

Merhaba,
Kod kullanmak isterseniz deneyiniz...

Sub kod()
Dim s As Object
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim ayr As String

ayr = "; "
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
Set s = CreateObject("Scripting.Dictionary")

For a = 2 To s1.Cells(s1.Rows.Count, 2).End(3).Row
    If Not s.exists(s1.Cells(a, "A").Value) Then
        s.Add s1.Cells(a, "A").Value, s1.Cells(a, "B").Value
    Else
   
    End If
Next

For a = 2 To s2.Cells(s2.Rows.Count, 2).End(3).Row
    If Not s.exists(s2.Cells(a, "A").Value) Then
        s.Add s2.Cells(a, "A").Value, s2.Cells(a, "B").Value
    Else
        s(s2.Cells(a, "A").Value) = s(s2.Cells(a, "A").Value) & ayr & s2.Cells(a, "B").Value
    End If
Next

s3.Range("A2").Resize(s.Count).Value = Application.Transpose(s.Keys())
s3.Range("B2").Resize(s.Count).Value = Application.Transpose(s.Items())
End Sub