• DİKKAT

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

Sayfalar arası veri bulup eşitleme

  • Konbuyu başlatan Konbuyu başlatan millis
  • Başlangıç tarihi Başlangıç tarihi
Katılım
27 Aralık 2006
Mesajlar
254
Excel Vers. ve Dili
Excel Visual Basic 6.0
Ektedi dosyada bulunan veriler1 ve veriler2 den oluşan iki sayfadaki kayıtlar,farklı satırlarda aynı kişilere ait bilgiler bulunmakta ve diger sayfada bunlarla ilgili veriler bulunmaktadır. Veriler1 de bulunan kayıt no adı soyadı dönemi ve kodunu diğer sayfadaki bilgilere denk gelen kısmı bulup veriler2 de bulunan verilerin karşısına Veriler1 deki tarih ve sayısını yazmasını istiyorum. Bu konuda yardımcı olacak üstadlara ve arkadaşlara şimdiden teşekkür ederim. Acil yardım.
 

Ekli dosyalar

Son düzenleme:
Yaptığınız çalışmayı kontrol ettim. Tşk.ederim ilginize. Fakat veriler içerisinde sıralı numaralar değil kişilerin birden fazla kaydı var ve bu kayıtların karşılıklarına aynı yapmış olduğunuz gibi işlem yapması gerekiyor. eğer bu şekilde bakarsanız sevinirim.
 
Eksiklik var

Yaptığınız çalışmayı kontrol ettim. Tşk.ederim ilginize. Fakat veriler içerisinde sıralı numaralar değil kişilerin birden fazla kaydı var ve bu kayıtların karşılıklarına aynı yapmış olduğunuz gibi işlem yapması gerekiyor. ve karşılıklarına fiş numaraları değil VERİLER1 deki tarih ve sayısının yazılması gerekiyor. Birde bu şekilde bakarsanız sevinirim. Teşekkür ederim.
 

Ekli dosyalar

Son düzenleme:
Yaptığınız çalışmayı kontrol ettim. Tşk.ederim ilginize. Fakat veriler içerisinde sıralı numaralar değil kişilerin birden fazla kaydı var ve bu kayıtların karşılıklarına aynı yapmış olduğunuz gibi işlem yapması gerekiyor. ve karşılıklarına fiş numaraları değil VERİLER1 deki tarih ve sayısının yazılması gerekiyor. Birde bu şekilde bakarsanız sevinirim. Teşekkür ederim.
Merhaba.
Yukarıdaki dosya değişti inceleyin.
fiş numaraları değil VERİLER1 deki tarih ve sayısının yazılması gerekiyor.

VERİLER1 deki tarih ve sayıdan kastınız "E" ve "F" sütunları değilmi?
 
Doğru VERİLER1 deki E ve F sütunlarındaki bilgiler VERİLER2 deki kayıtların karşılarına gelecek. Ancak VERİLER de dikkatinizi çektiyse her kişi kaydından birer tane değil birden fazla aynı isim ve numaradan kayıt var. onları ayıran şey dönem ve kodları. Bu kişilerin dönem ve kodlarına karşılık gelen kısımlar aktarılacak. Şöyleki; VERİLER1de " Mehmet" adındaki kişinin 9 kaydı var. dönemleri ve kodları farklı yani " C " ve " D " sütunları bu dönemlere ve kodlara denk gelen VERİLER2 deki dönem ve kodları bulup, ( yine " C " ve " D " sütunlarındaki bilgiler ) VERİLER1 deki TARİH ve SAYI yı VERİLER2 deki " G " ve " H " sütunlarına aktarması gerekiyor.
 
Dosyanın tamamı

Slm. Üstad. Konuyla ilgili dosyanın tamamı ektedir.
 
Dosyanın tamamı

Slm üstad. Dosya verilerinin bir bölümü ektedir. İlgilenirseniz sevinirim. Şimdiden teşekkür ederim. Sizin yapmış olduğunuz dosyada her numara farklı ancak bazı şahıslardan ve aynı numaralardan birkaç tane var. bunları ayırıştıran dönemleri ve kod numaraları
 

Ekli dosyalar

Son düzenleme:
Slm üstad. Dosya verilerinin bir bölümü ektedir. İlgilenirseniz sevinirim. Şimdiden teşekkür ederim. Sizin yapmış olduğunuz dosyada her numara farklı ancak bazı şahıslardan ve aynı numaralardan birkaç tane var. bunları ayırıştıran dönemleri ve kod numaraları

"Veriler1" sayfasına bir buton ekleyip kodları deneyin.

Kod:
Private Sub CommandButton1_Click()
Sheets("VERİLER2").Select
For a = 2 To Cells(65000, 1).End(xlUp).Row
Set b = Sheets("VERİLER2").Range("A2:A65536").Find(What:=Cells(a, 5), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not b Is Nothing Then
If a = Cells(65000, 1).End(xlUp).Row Then _
    Application.EnableEvents = False
    fg = b.Address
    Do
  If Sheets("VERİLER2").Range("a" & b.Row).Value = Range("e" & a).Value And _
 Sheets("VERİLER2").Range("b" & b.Row).Value = Range("f" & a).Value And _
 Sheets("VERİLER2").Range("c" & b.Row).Value = Range("ı" & a).Value And _
 Sheets("VERİLER2").Range("d" & b.Row).Value = Range("j" & a).Value Then
Range("l" & a & ":m" & a).Copy Sheets("VERİLER2").Range("g" & b.Row & ":h" & b.Row)
Sheets("VERİLER2").Range("g" & b.Row).Select
End If
 Set b = Sheets("VERİLER2").Range("A2:A65536").FindNext(b)
    Loop While Not b Is Nothing And b.Address <> fg
    Application.EnableEvents = True
End If
Set b = Nothing
Next

End Sub

Örnek dosya aşağıdaki linkte:

http://s2.dosya.tc/server7/LGDMTV/Xl0000025.zip.html
 
Geri
Üst