• DİKKAT

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

Sonrakini bul

Katılım
14 Haziran 2006
Mesajlar
575
Sayfa1'de no sutunundaki A sutunu numaralara karşılık gelen sicil sutununda B sutununda aynı olanlar var.Bunları Sayfa2de aynı nolara karşılık gelen sicilleri verinin karşısına yazdırmak istiyorum.Örnek 123 karşısına F,G,H sutunlarına a1 a2 c1 yazacak.Düşeyara ile yaptım olmadı.Bir kodla yapılabilirmi.
 

Ekli dosyalar

Sayfa1'de no sutunundaki A sutunu numaralara karşılık gelen sicil sutununda B sutununda aynı olanlar var.Bunları Sayfa2de aynı nolara karşılık gelen sicilleri verinin karşısına yazdırmak istiyorum.Örnek 123 karşısına F,G,H sutunlarına a1 a2 c1 yazacak.Düşeyara ile yaptım olmadı.Bir kodla yapılabilirmi.

Merhaba,

F7 hücresine yazıp dizi formülüne çevirdikten sonra yana ve alt hücrelere kopyalayın.

Kod:
=EĞER(SÜTUNSAY($F7:F7)>EĞERSAY(Sayfa1!$A$2:$A$10;$E7);"";İNDİS(Sayfa1!$B$2
 :$B$10;KÜÇÜK(EĞER(Sayfa1!$A$2:$A$10=$E7;SATIR(Sayfa1!$A$2
  :$A$10)-SATIR(Sayfa1!$A$2)+1);SÜTUNSAY($F7:F7))))
Dizi formülü: Formülü hücreye yazdıktan sonra entera basmadan ctrl shift enter tuş kombinasyonu ile girişini tamamlayınız.

.
 
Nadir bey merhaba. ;)

Aşağıdaki kodları bir module içine yazıp bir kere çalıştırın bakalım istediğinizi yapıyorlar mı ?
Yalnız verilerde 123 ve 789 verilerini birden fazla kullanmışsınız. Bilginize.

Kod:
Sub veribulyaz()
Dim s1 As Worksheet, s2 As Worksheet
Dim i As Long, son1 As Long, son2 As Long, b As Byte
Dim evn As Range
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
son1 = s1.Range("a65536").End(3).Row
son2 = s2.Range("e7").End(4).Row
    For i = 2 To son1
        Set evn = s2.Range("e7:e" & son2).Find(CStr(s1.Cells(i, "a").Value))
        If Not evn Is Nothing Then
            b = 1
            Do While Not evn.Offset(0, b).Value = Empty
                b = b + 1
            Loop
                evn.Offset(0, b).Value = s1.Cells(i, "b").Value
        End If
    Next i
i = Empty: son1 = Empty: son2 = Empty: b = Empty
Set s1 = Nothing: Set s2 = Nothing: Set evn = Nothing
End Sub

Uzun zamandır Excel çalışmaları yapıyorsunuz. Neden Excel' e yeni başlayanlar başlığına yolladınız açıkçası biraz şaşırmadım değil.
 
ömer bey ve Tarkan bey Formül ve kodlar için teşekkürler her ikiside güzel çalışıyorlar.İnsan en iyi bildiğini dahi o an unutabiliyor.Özür dilerim.
 
Geri
Üst