LİSTEDEN VERİ ALARAK LİSTE AYIKLAMA

[yavuz_yil]

Değerli hocalarım ek dosyadaki veri tablosundan bir liste oluşturmak istiyorum. Topla Çarpım ve düşeyara ile aynı isimlerden farklı veriler olduğu için yapamadım.Acaba indis ile falan mı yapılması gerekiyor? Yardımcı olabilirseniz minnettar olurum. Saygılarımla,

Lifebox Transfer: Upload File! Send and Share Large Files

Lifeboxtransfer is a fast file transfer service for sharing your files easily without membership. Click and start sharing your files fast and easily with lifeboxtransfer.

lifeboxtransfer.com

 

[hasankardas]

Sub ProgramAdiAraVeGetir()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim matchRow As Variant
    Dim lastRow As Long
   
    Set ws1 = ThisWorkbook.Sheets("SINAV YAPILACAKLAR")
    Set ws2 = ThisWorkbook.Sheets("E-LEARNING")
   
    ' Temizleme işlemi
    ws1.Range("B2:E1000").ClearContents
   
    j = 2
    For i = 2 To 8
        lastRow = ws2.Cells(ws2.Rows.Count, "F").End(xlUp).Row
        ' Her bir Program Adı için tüm satırları kontrol et
        For k = 1 To lastRow
            If ws2.Cells(k, "F").Value = ws1.Cells(i, "P").Value Then
                ws1.Cells(j, "B").Value = ws2.Cells(k, "A").Value  
                ws1.Cells(j, "C").Value = ws2.Cells(k, "C").Value  
                ws1.Cells(j, "D").Value = ws2.Cells(k, "D").Value  
                ws1.Cells(j, "E").Value = ws2.Cells(k, "F").Value  
                j = j + 1
            End If
        Next k
    Next i
End Sub

dener misiniz. sayfa isminiz de boşluk var onu kaldırığ öyle deneyin

 

[yavuz_yil]

Sub ProgramAdiAraVeGetir()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim matchRow As Variant
    Dim lastRow As Long
  
    Set ws1 = ThisWorkbook.Sheets("SINAV YAPILACAKLAR")
    Set ws2 = ThisWorkbook.Sheets("E-LEARNING")
  
    ' Temizleme işlemi
    ws1.Range("B2:E1000").ClearContents
  
    j = 2
    For i = 2 To 8
        lastRow = ws2.Cells(ws2.Rows.Count, "F").End(xlUp).Row
        ' Her bir Program Adı için tüm satırları kontrol et
        For k = 1 To lastRow
            If ws2.Cells(k, "F").Value = ws1.Cells(i, "P").Value Then
                ws1.Cells(j, "B").Value = ws2.Cells(k, "A").Value 
                ws1.Cells(j, "C").Value = ws2.Cells(k, "C").Value 
                ws1.Cells(j, "D").Value = ws2.Cells(k, "D").Value 
                ws1.Cells(j, "E").Value = ws2.Cells(k, "F").Value 
                j = j + 1
            End If
        Next k
    Next i
End Sub

dener misiniz. sayfa isminiz de boşluk var onu kaldırığ öyle deneyin

Yardımınız için teşekkür ederim. Maalesef boşluğu kaldırdım ama genede çalışmadı.

 

[hasankardas]

Yardımınız için teşekkür ederim. Maalesef boşluğu kaldırdım ama genede çalışmadı.

Kontrol edip paylaşmıştım.

İndir çalışma

Dosyayı indir çalışma

dosya.co

 

[yavuz_yil]

Ben sayfa ismi boşluğunu aradaki boşluk olarak değerlendirip alıyordum. Sonda varmış şimdi fark ettim. Dediğiniz gibi çalıştı. Çok teşekkür ederim...