Mükerrer Veri Aktarma

Katılım
1 Ağustos 2006
Mesajlar
77
Excel Vers. ve Dili
Excel 2003 Türkçe
Arkadaşlar forumda mükerrer kayıtla ilgili konuları inceledim gönderdiğim dosyaya uyarlayamadım. Kolay olduğunu düşünüyorum ancak ben yapamadım. Sizin yardımlarınızı bekliyorum. Şimdiden teşekkürler.
 
Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Aşağıdaki kodları kullanabilirsiniz.

Kod:
Sub Aktar()
Dim a, i, s As Long, b()
Set s1 = Sheets("Personel")
Set s2 = Sheets("Veri")
a = s1.Range("a2:a" & s1.[a65536].End(xlUp).Row).Resize(, 6).Value
ReDim b(1 To UBound(a, 1), 1 To 6)
With CreateObject("Scripting.Dictionary")
     .CompareMode = vbTextCompare
     For i = 1 To UBound(a, 1)
          If Not .exists(a(i, 2)) Then
               s = s + 1
               .Add (a(i, 2)), s
               b(s, 1) = s
               b(s, 2) = a(i, 2)
               b(s, 3) = a(i, 3)
               b(s, 4) = a(i, 4)
               b(s, 5) = a(i, 5)
               b(s, 6) = a(i, 6)
          End If
    Next
End With
With s2.Range("a2")
    .Resize(, 6).ClearContents
    .Resize(s, 6).Value = b
End With
MsgBox "Bitti"
s2.Select
[a1].Select
Set s1 = Nothing
Set s2 = Nothing
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,456
Excel Vers. ve Dili
Ofis 365 Türkçe
Sayın ripek yanıtlamış.

Bende soruyu şöyle anladım : Personel bilgileri sayfasında çift kayıt girişi engellenmeli ve buradaki bilgileri Veri sayfasına aktarıma sağlayacak bir kod.

Bu mantığa göre hem dosyayı hem de kodları inceleyiniz.

Personel sayfasında B sütununda çift kayıt girişi engellendi.

Kod:
Public Sub Getir()
Application.ScreenUpdating = False
Set p = Sheets("Personel")
Range("A2:F65536").ClearContents
Satır = 1
For i = 2 To p.[B65536].End(3).Row
    Satır = Satır + 1
    Cells(Satır, "A") = p.Cells(i, "A")
    Cells(Satır, "B") = p.Cells(i, "B")
    Cells(Satır, "C") = p.Cells(i, "C")
    Cells(Satır, "D") = p.Cells(i, "D")
    Cells(Satır, "E") = p.Cells(i, "E")
    Cells(Satır, "F") = p.Cells(i, "F")
Next i
Application.ScreenUpdating = True
MsgBox "Aktarım Bitmiştir........"
End Sub
 
Katılım
1 Ağustos 2006
Mesajlar
77
Excel Vers. ve Dili
Excel 2003 Türkçe
Veri Aktarma

Arkadaşlar Sorum ile ilgilendiğiniz için teşekkür ederim. Gönderdiğiniz dosyaları inceledim. veri aktarımı yapıyor,personele girilen bilgiler çift kayıt engellenmiş buda güzel. Ancak benin istediğim ;

Personel sayfasında tek satıra bilgi girişi (2.satır)yapılıyor.Bu tek satıra yapılan farklı bilgi girişleri Veri Sayfasına mükerrer kaydı engelleyerek alt alta ilave etsin.
Gönderdiğim Dosyada personel sayfasındaki 1. ve 2. satır harici siyah zemin yani, siyah zeminlere bilgi girişine kapalı.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,656
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Ekteki örnek dosyayı incelermisiniz. F12 tuşu ile aktarım yapılmaktadır.
 
Katılım
1 Ağustos 2006
Mesajlar
77
Excel Vers. ve Dili
Excel 2003 Türkçe
Veri Aktarma

Arkadaşlar ilginize Teşekkür Ederim. İstediğim oldu
 
Katılım
15 Kasım 2007
Mesajlar
29
Excel Vers. ve Dili
excell 2002
Değerli uzmanlar dosyam ekte verileri ya aktarırken teke indirmeliyim yada veri doğrulama ile çağırırken. veri doğrulamada aynı veriyi tekrar görmemem gerekiyor ??
 
Üst