Veri Aktarma

Katılım
1 Ağustos 2019
Mesajlar
73
Beğeniler
0
Excel Vers. ve Dili
türkçe excel 2016
#1
Değerli üstatlarım 5000 satırlık bir personel listem var. Bu satır sayısı gün geçtikçede artmaktadır. Projeler arası personel giriş çıkışı çok olmaktadır. Kullanmış olduğum makro sadece mükerrer kayıtlarda bana sorun çıkarmaktadır. Benim yapmak istediğim girmiş olduğum toplu verilerde Ana sayfaya aktardığımda TC Kimlik numarasına göre arama yapıp mükerrer olmayan kayıtlara verileri aktarması, mükerrrer kayıtlarda ise veriyi İŞTEN AYRILAN mükerrer kayıta değilde ETKİN olarak gözüken mükerrer kayıta veriyi aktarmasını istiyorum. Örnek kayıtları çalışma sayfasında paylaştım. Kullanmış olduğum makroda sayfada mevcuttur. Şimdiden yardımlarınız için teşekkürler.
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
21,711
Beğeniler
430
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#10
Userformla veri aktarırkenmi bu mükererlik kontrolu yapılacak.
Birde Etkin hangi sütun,işten ayrılan hangi sütun?
 
Katılım
1 Ağustos 2019
Mesajlar
73
Beğeniler
0
Excel Vers. ve Dili
türkçe excel 2016
#11
Userformla veri aktarırkenmi bu mükererlik kontrolu yapılacak.
Birde Etkin hangi sütun,işten ayrılan hangi sütun?
Evren hocam İŞTEN ÇIKIŞ sayfasındaki çizelgeye bilgileri yazıp ANA SAYFA sayfasına aktarırken mükerrer kontrolü yapacak. Mevcut makro yapıyor. Ancak Aynı personel 3 defa giriş çıkış yaptığında veriyi en son güncel kayda aktaracağına bir önceki mükerrer kayda aktarıyor. Bende bu sorunu X sütununda bulunan Etkin ve İşten Çıkış durumunu baz alarak aşabileceğimi düşündüm. Yani verileri çalışma durumu Etkin yazan mükerrer kayda aktarması durumunda sorun çözülür
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
21,711
Beğeniler
430
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#12
Öncekini silin bunu yazın.
Kod:
Sub aktar_59()
Dim sh As Worksheet, k As Range, sonsat As Long, i As Long
Dim adr As String
Set sh = Sheets("ANA SAYFA")
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To sonsat
    Set k = sh.Range("C3:C" & Rows.Count).Find(Range("A" & i).Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            If sh.Cells(k.Row, "X").Value = "Etkin" Then
                sh.Cells(k.Row, "K").Value = Range("B" & i).Value
                sh.Cells(k.Row, "L").Value = Range("C" & i).Value
                sh.Cells(k.Row, "X").Value = Range("D" & i).Value
                Exit Do
            End If
            Set k = sh.Range("C3:C" & Rows.Count).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
Next
MsgBox "BİTTİ"
End Sub
 
Katılım
1 Ağustos 2019
Mesajlar
73
Beğeniler
0
Excel Vers. ve Dili
türkçe excel 2016
#13
Öncekini silin bunu yazın.
Kod:
Sub aktar_59()
Dim sh As Worksheet, k As Range, sonsat As Long, i As Long
Dim adr As String
Set sh = Sheets("ANA SAYFA")
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To sonsat
    Set k = sh.Range("C3:C" & Rows.Count).Find(Range("A" & i).Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            If sh.Cells(k.Row, "X").Value = "Etkin" Then
                sh.Cells(k.Row, "K").Value = Range("B" & i).Value
                sh.Cells(k.Row, "L").Value = Range("C" & i).Value
                sh.Cells(k.Row, "X").Value = Range("D" & i).Value
                Exit Do
            End If
            Set k = sh.Range("C3:C" & Rows.Count).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
Next
MsgBox "BİTTİ"
End Sub
Evren Hocam Allah senden razı olsun süpersin valla çok teşekkür ederim
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
21,711
Beğeniler
430
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#14
Rica ederim.O sizin süperliğiniz.
İyi çalışmalar.:cool:
 
Üst