Excell'le yapılabilir mi?

[bmyavuz]

Kusura bakmayın, konuyu açmadan önce arama butonuyla birçok arma yaptım ancak ne arayacağımı dahi tam olarak bilmediğim için bir sonuca varamadım!
Değerli excell üstadları. Elimizde var olan bir listedeki kişileri, uyruk ve cinsiyeti de dahil olmak üzere diğer sayfalarda bulunan yerleşim planlarındaki ait oldukları yerlere aktarmanın ( daha doğrusu orada da gözükmelerinin) bir yolunu arıyorum. Acaba bu mümkün mü? Yardımlarınız için şimdiden teşekküreler.
Saygılar...

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir butona bağlayıp deneyebilir misiniz?

Sub Dagit()
Dim i As Long
Dim j As Integer
Set s1 = Sheets("Sayfa1")
For i = 2 To s1.[B65536].End(3).Row
    For j = 2 To Sheets.Count
        With Sheets(j).Range("C:C")
            Set c = .Find(s1.Cells(i, "B"), LookIn:=xlValues)
            If Not c Is Nothing Then
                Sat = Sheets(j).Cells(c.Row + 4, "C").End(3).Row + 1
                    Sheets(j).Cells(Sat, "B") = s1.Cells(i, "C")
                    Sheets(j).Cells(Sat, "C") = s1.Cells(i, "A")
                    Sheets(j).Cells(Sat, "D") = s1.Cells(i, "D")
                Exit For
            End If
        End With
    Next j
Next i
End Sub

 

[Orion1]

Dosyanız Ekte.

Sub aktar()
Dim i  As Integer, k As Range, z As Long
Sheets(1).Select
Application.ScreenUpdating = False
For t = 2 To Cells(65536, "A").End(xlUp).Row
    For i = 2 To Worksheets.Count
        If Cells(t, "B").Value = Empty Then GoTo atla
        Set k = Sheets(i).Range("C:C").Find(Cells(t, "B").Value, , xlValues, xlWhole)
            If Not k Is Nothing Then
                For z = k.Row + 1 To k.Row + 4
                    If Sheets(i).Cells(z, "C").Value = "" Then
                        Sheets(i).Cells(z, "B").Value = Cells(t, "C").Value
                        Sheets(i).Cells(z, "C").Value = Cells(t, "A").Value
                        Sheets(i).Cells(z, "D").Value = Cells(t, "D").Value
                        Exit For
                    End If
                Next z
                Exit For
            End If
atla:
    Next i
Next t
Set k = Nothing
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır..", vbOKOnly + vbInformation, "İŞLEM TAMAM"
End Sub

 

[bmyavuz]

İlginiz için teşekkür ederim, ancak bu yöntemin benim işime yaramayacağını anladım. Nedeni elimden oldukça büyük bir yerleşim planı olacak. Ayrıca yerleşlim planında içerik temizlediğimde tekrardan aktarma yapamadım. Acaba bu işi formül kullanarak yapma şansım var mı? Yani şöyle; ilgili yere yazacağımız bir formül ile listeden ilgili yerinin adının geçtiği satırı o hücreye aktarma şansımız var mıdır? İstediğimi düzgün ifade edemediğimin farkındayım örnek dosyayı ekledim...
Saygılar...

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Dizi formülü ile hazırlanmıştır. Formülleri kendinize uyarlamak isterseniz formülü yazdıktan sonra hücreyi terk ederken CTRL+SHIFT+ENTER tuşlarına basarak terk etmeniz gerekmektedir. Aksi halde formül hatalı sonuç üretecektir.

 

[janveljan]

Bir iki fazla sütun ekleyerek ben de bir çözüm ürettim, düşeyara fonksiyonunu ve eğersay ilede o odada kaç kişi kaldığını saydırarak bir çözüm ürettim.

 

[bmyavuz]

Necdet, Evren ve Korhan Bey'lerin her üçünede sonsuz teşekkürler. Korhan Bey, sağ olsun sizin formülle yapmak istediğimi gerçekleştirebilirim. Amacamı ulaştım. Eksik olmayın...
Saygılar...