İki sheet arasında verinin aranıp bulunması ve diğer tarfa aktarılması

[ulashcan]

Ekteki örnek dosyada açıklamaya çalıştığım gibi, iki sheet arasında veri transferi yapmak istiyorum.

Şöyle ki, her sheet'de ayrı bir bölüme ait uygunsuzlukların yazıldığı bir çalışma kitabı var.
Bu kitaptaki tüm uygunsuzluk sheetlerini tarayarak,
A sütunundaki soru numarasını bulacak, bulduğu hücrenin 3 sütun yanındaki puanı alacak,
tüm soruların olduğu sheetde aynı soru numarasını arayıp bulacak,
3 sütun yanına uygunsuzluklar sayfasından bulduğu puanı yazacak.

Yardımcı olabilir misiniz?

 

[ulashcan]

İstediğim şey çok mu karışık acaba?

Aslında işimi görecek fonksiyonun temeli şu...

Bir aralığı tara, bulduğun değerleri al, başka bir aralıkta aynı değerleri sırasıyla ara, bulunca filanca sütun yanındaki değeri buraya yaz.

Excelde böyle bir işi yapmak zor mudur?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub AKTAR()
    Dim ALAN As Range
    Set SS = Sheets("Sorular")
    SS.Select
    For Each ALAN In Columns("A:A").SpecialCells(xlCellTypeConstants, 1)
    For X = 1 To Sheets.Count
    If UCase(Sheets(X).Name) Like "*" & "UYGUNSUZLUKLAR" & "*" Then
    Set BUL = Sheets(X).Cells.Find(ALAN.Value, LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    Cells(ALAN.Row, 4) = Sheets(X).Cells(BUL.Row, 3)
    End If
    End If
    Next
    Next
    Set SS = Nothing
    Set BUL = Nothing
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ulashcan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub AKTAR()
    Dim ALAN As Range
    Set SS = Sheets("Sorular")
    SS.Select
    For Each ALAN In Columns("A:A").SpecialCells(xlCellTypeConstants, 1)
    For X = 1 To Sheets.Count
    If UCase(Sheets(X).Name) Like "*" & "UYGUNSUZLUKLAR" & "*" Then
    Set BUL = Sheets(X).Cells.Find(ALAN.Value, LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    Cells(ALAN.Row, 4) = Sheets(X).Cells(BUL.Row, 3)
    End If
    End If
    Next
    Next
    Set SS = Nothing
    Set BUL = Nothing
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sayın Korhan Ayhan, yardımınız için teşekkür ederim ama kodu uyguladığımda ne yaptığını anlayamadım, biraz inceleyip anlamaya çalışacağım.

Özet olarak yapmak istediğim şey, uygunsuzluklar sheetlerinde belli aralıkta (A6:A20 gibi) yer alan değerlerin sorular sheetinde aranıp bulunması, Uygunsuzluklar Sheetlerinde bulunan her maddeye ait puanın Sorular sheetinde aynı madde puanı olarak işlenmesi.

Örneğin: Bölüm1 uygunsuzluklar sheetinde 1007 nolu soru yer alıyorsa, bu sorunun puanı olan "0" 'ı, Sorular Sheetinde 1007 nolu sorunun puanı olarak değiştirmesi. Orjinalinde Sorular sheetinde 1007 nolu sorunun değeri 5 olarak duruyordu, ama Uygunsuzluklar sheetinde 1007 nolu soru yer aldığı ve puan değeri 0 olarak tespit edildiği için Sorular sheetindeki 1007 nolu sorunun 5 olan değeri 0 olarak değiştirilecek, uygunsuzluklar sheetlerinde yer almayan soruların puanı orjinaldeki haliyle tam puan olarak kalacak.

Bu arada uygunsuzluklar sheetinde yer alan soruların puanı her zaman 0 olmuyor, bazen -3 gibi negatif rakamlar da olabiliyor.