ÇALIŞMA KİTABINDAKİ VERİLERİ AYNI ÇALIŞMA KİTABINDA GEREKLİ YERLERE AKTARMA

m.ensar

Altın Üye
Katılım
5 Nisan 2016
Mesajlar
348
Excel Vers. ve Dili
office 10 türkçe
Altın Üyelik Bitiş Tarihi
25-10-2025
Merhaba iyi günler iyi seneler
ekli tabloda personel bilgileri sayfasındaki verileri kıdem tazminatı hesaplama sayfasında kişi ismini girdiğimde gerekli yerlerin karşılarına otomatik gelmesini istiyorum. örneğin tc numarası doğum yeri gibi bilgiler geliyor ama işe başlama tarihi gelmiyor. yine örnek 2 hizmet cetveli sayfasında ihale konusu iş satırının karşılığı değişmiyor seçilen kişi ne iş yapıyorsa o gelmeli
 

Ekli dosyalar

likaba

Altın Üye
Katılım
3 Mayıs 2016
Mesajlar
158
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
21-12-2027
Aşağıdaki kodları ilgili hücrelere yazınız

örnek2 hizmet cetvelis sayfası
=DÜŞEYARA(B6;PERSONEL!B:H;5;0)

kıdem tazminatı hesaplama sayfası
=DÜŞEYARA(B4;PERSONEL!B:H;7;0)
 

m.ensar

Altın Üye
Katılım
5 Nisan 2016
Mesajlar
348
Excel Vers. ve Dili
office 10 türkçe
Altın Üyelik Bitiş Tarihi
25-10-2025
Likaba üstadım teşekkürler
 

likaba

Altın Üye
Katılım
3 Mayıs 2016
Mesajlar
158
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
21-12-2027
rica ederim, iyi günler
 

m.ensar

Altın Üye
Katılım
5 Nisan 2016
Mesajlar
348
Excel Vers. ve Dili
office 10 türkçe
Altın Üyelik Bitiş Tarihi
25-10-2025
Private Sub ListBox1_Click()
a = ActiveCell.Row
ActiveCell = ListBox1.Value
ListBox1.Visible = False
ActiveCell.Offset(0, 1).Select
If WorksheetFunction.CountBlank(Range("B" & a & ":M" & a)) > 0 Then
MsgBox "Lütfen tüm alanları doldurunuz!"
Set c = Range("A" & a & ":N" & a).Find("")
If Not c Is Nothing Then c.Select
Else
For i = 1 To Sheets.Count
If Sheets(i).Name = Cells(a, "N") Then
yeni = Sheets(i).Cells(Rows.Count, "B").End(3).Row + 1
If WorksheetFunction.CountIf(Sheets(i).Range("D1:D" & yeni), Cells(a, "D")) > 0 Then
sat = WorksheetFunction.Match(Cells(a, "D"), Sheets(i).Range("D1:D" & yeni), 0)
Range("B" & a & ":N" & a).Copy Sheets(i).Cells(sat, "B")
MsgBox a - 1 & ". veri " & Cells(a, "N") & " güncellendi.", vbInformation
Cells(a + 1, "B").Select
Exit Sub
Else
Range("B" & a & ":N" & a).Copy Sheets(i).Cells(yeni, "B")
Sheets(i).Cells(yeni, "A") = yeni - 1
Cells(a, "A") = a - 1
End If
End If
Next
End If
MsgBox a - 1 & ". veri " & Cells(a, "N") & " sayfasına aktarıldı.", vbInformation
Cells(a + 1, "B").Select
End Sub

YUKARIDA Kİ
If WorksheetFunction.CountIf(Sheets(i).Range("D1:D" & yeni), Cells(a, "D")) > 0 Then
sat = WorksheetFunction.Match(Cells(a, "D"), Sheets(i).Range("D1:D" & yeni), 0) Koduyla D sütunundaki veri göz önüne alınarak baska sayfaya aktarım yapılıyor. Yusuf hocam sağolsun yapmıştı. D sütununu gözetirken aynı anda G sutununuda dikkate alarak aktarım yapılması mümkün mü. durum şöyleki a şahsı b şahsı adına başvuru yapıyor a şahsının TC si D sutununda A şahsı ikinci bir kişi için diyelim ki c şahsı içinde başvuru yapıyor o zaman kod a şahsının ilk başvurusunu güncelliyor. o yüzden A şahsının TC si olan D sutunu ve başvurulan kişinin TC si olan G sutununu da doğruladıktan sonra aktarım yapmalı.
Şimdiden teşşekürler
 

m.ensar

Altın Üye
Katılım
5 Nisan 2016
Mesajlar
348
Excel Vers. ve Dili
office 10 türkçe
Altın Üyelik Bitiş Tarihi
25-10-2025
Private Sub ListBox1_Click()
a = ActiveCell.Row
ActiveCell = ListBox1.Value
ListBox1.Visible = False
ActiveCell.Offset(0, 1).Select
If WorksheetFunction.CountBlank(Range("B" & a & ":M" & a)) > 0 Then
MsgBox "Lütfen tüm alanları doldurunuz!"
Set c = Range("A" & a & ":N" & a).Find("")
If Not c Is Nothing Then c.Select
Else
For i = 1 To Sheets.Count
If Sheets(i).Name = Cells(a, "N") Then
yeni = Sheets(i).Cells(Rows.Count, "B").End(3).Row + 1
If WorksheetFunction.CountIf(Sheets(i).Range("D1:D" & yeni), Cells(a, "D")) > 0 Then
sat = WorksheetFunction.Match(Cells(a, "D"), Sheets(i).Range("D1:D" & yeni), 0)
Range("B" & a & ":N" & a).Copy Sheets(i).Cells(sat, "B")
MsgBox a - 1 & ". veri " & Cells(a, "N") & " güncellendi.", vbInformation
Cells(a + 1, "B").Select
Exit Sub
Else
Range("B" & a & ":N" & a).Copy Sheets(i).Cells(yeni, "B")
Sheets(i).Cells(yeni, "A") = yeni - 1
Cells(a, "A") = a - 1
End If
End If
Next
End If
MsgBox a - 1 & ". veri " & Cells(a, "N") & " sayfasına aktarıldı.", vbInformation
Cells(a + 1, "B").Select
End Sub


Dün kodları kopyala yapıştır yaparken kayma meydana gelmiş orjinal hali bu yardımcı olabilir misiniz?...
YUKARIDA Kİ
If WorksheetFunction.CountIf(Sheets(i).Range("D1:D" & yeni), Cells(a, "D")) > 0 Then
sat = WorksheetFunction.Match(Cells(a, "D"), Sheets(i).Range("D1:D" & yeni), 0) Koduyla D sütunundaki veri göz önüne alınarak baska sayfaya aktarım yapılıyor. Yusuf hocam sağolsun yapmıştı. D sütununu gözetirken aynı anda G sutununuda dikkate alarak aktarım yapılması mümkün mü. durum şöyleki a şahsı b şahsı adına başvuru yapıyor a şahsının TC si D sutununda A şahsı ikinci bir kişi için diyelim ki c şahsı içinde başvuru yapıyor o zaman kod a şahsının ilk başvurusunu güncelliyor. o yüzden A şahsının TC si olan D sutunu ve başvurulan kişinin TC si olan G sutununu da karşılaştırıp D sutununda ki TC aynı ancak G sutunundaki TC farklı ise yeni kayıt oluşturmalı.
Şimdiden teşşekürler
ÖRNEK DOSYA EKTEDİR
 

Ekli dosyalar

Üst