• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Farklı sayfalardaki verileri ilk sayfada görünür yapmak

Katılım
12 Şubat 2013
Mesajlar
38
Excel Vers. ve Dili
2003 türkçe
ARKADAŞLAR,

Ek'teki dosyada E kodu ve V kodu olarak kişilere kodlamalar yapılmıştır.
E ve V kodu birden fazla kişide olabilir ve aynı zamanda kişilerdede birden fazla E ve V kodu olabilir.Bu bilgiler E ve V sayfalarına günlük kişi adı ve ilgili kodu ilave edilerek liste aşağıya doğru uzamaktadır.(NOT:eski kayıt duracak yeni ilaveler aşağıya doğru yapılmaktadır.)
sonuçta ,sayfa 1'de görülmek istenen ;Sayfa 1 de kod u alıp kişi adınıda alıp bu iki kritere göre E ve V sayfasndaki isimlerin yanlarında kodlar mevcut ise
ilk sayfada E için kişi adı ve E kodu keşiştiği yerdeki E ye "X" işareti koyacak eger kişide kod yok ise boş bırakılacaktır.
aynı işlem ilk sayfada V için kişi adı ve V kodu keşiştiği yerdeki V ye "X" işareti koyacak eger kişide kod yok ise boş bırakılacaktır.

not :kişi adı ve kod sınırlı değil ilava edilebilmektedir
not: sayfa 1 de kod ları olduğu yerde boşluklar mevcuttur .boş olan kod satırı değerlendirilmeyecektir.

Foruma katkısı olan herkesin ellerine sağlık.
Teşekkürler.
 

Ekli dosyalar

Son düzenleme:
merhaba, aşağıdaki kodu bir modüle kopyalayıp deneyiniz.. ancak sayfa1 deki kodlarınız (A1,A2,A3 ...) d8 hücresinden başlamaktadır..doğru sonucu almak için onları bir hücre aşağıya kaydırın.Yani d9 hücresinden başlasınlar..kolay gelsin..

Sub deneme()
Application.ScreenUpdating = False
For x = 10 To Sheets(2).[d10000].End(3).Row
If Sheets(2).Cells(x, "d") <> "" Then
a = WorksheetFunction.Match(Sheets(2).Cells(x, "d"), Sheets(1).Range("d1:d10000"), 0)
b = WorksheetFunction.Match(Sheets(2).Cells(x, "c"), Sheets(1).Range("a5:dz5"), 0)
Sheets(1).Cells(a, b) = "X"
End If
Next x
For y = 10 To Sheets(3).[d10000].End(3).Row
If Sheets(3).Cells(y, "d") <> "" Then
c = WorksheetFunction.Match(Sheets(3).Cells(y, "d"), Sheets(1).Range("d1:d10000"), 0)
d = WorksheetFunction.Match(Sheets(3).Cells(y, "c"), Sheets(1).Range("a5:dz5"), 0)
Sheets(1).Cells(c, d + 1) = "X"
End If
Next y
MsgBox "İşleminiz bitmiştir.", vbInformation
Application.ScreenUpdating = True
End Sub
 
sorunum çözüldü yardımlarınız için çok teşekkürler
 
Geri
Üst