Otomatik Doldurma

Katılım
19 Haziran 2017
Mesajlar
219
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
05-04-2024
Merhaba,

Personelin amirlerinin sicillerini zamanında il ile kenarlarına yazmıştık. şuan isimlerinide yazırmak istiyoruz.

Mevcutta siciller yazılı, sicilleri parçalayarak ayrı ayrı örnekte olduğu gibi isimleride yazdırabilir miyiz?
 

Ekli dosyalar

S.Yiğit

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2008
Mesajlar
1,748
Excel Vers. ve Dili
2019 TR
Emre bey,

Aşağıdaki konuyla ilgili son durum nedir? Çalıştıramadım malesef yazmıştınız en son.

 
Katılım
19 Haziran 2017
Mesajlar
219
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
05-04-2024
Emre bey,

Aşağıdaki konuyla ilgili son durum nedir? Çalıştıramadım malesef yazmıştınız en son.

Hocam o konu askıda, orada bu bahsettiğim verileri çekip ayrı ayrı sicil olarak isimlerini yazdıracağım. Kasıyor bilgisayarım. beceremedim nasıl olduysa.

Dosya'Da bir problem var 2dk da açılıyor sayfa.

=EĞERHATA(İNDİS('Veri (3)'!C:C;KAÇINCI(Sayfa1!C2&Sayfa1!L2;'Veri (3)'!A:A&'Veri (3)'!B:B;0));"")

ctrl shift enter ile çalıştırıyorum boşluk çıkıyor hatada yok
 
Katılım
19 Haziran 2017
Mesajlar
219
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
05-04-2024
Merhaba,

Personelin amirlerinin sicillerini zamanında il ile kenarlarına yazmıştık. şuan isimlerinide yazırmak istiyoruz.

Mevcutta siciller yazılı, sicilleri parçalayarak ayrı ayrı örnekte olduğu gibi isimleride yazdırabilir miyiz?
Güncel
 
Katılım
19 Haziran 2017
Mesajlar
219
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
05-04-2024
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
a = Target
b = Len(a) - Len(WorksheetFunction.Substitute(a, ",", "")) + 1
c = 1
For i = 1 To b
d = WorksheetFunction.Find(",", a, c)
If d < c Then d = Len(a) + 1
e = Mid(a, c, d - c) * 1
f = WorksheetFunction.VLookup(e, Sheets("Sayfa1").Range("C6:D18"), 2, 0)
g = f & ","
h = h & g
c = d + 1
Next
1:
Target.Cells.Offset(0, 1).Value = Left(h, Len(h) - 1)
End Sub


Başka bir forumda cevap gelmiş konuya ancak, kodu çalıştıramadım ancak. Buton eklemeye çalıştım hata verdi.


"Sayfa1 deki C ve D sütunlarını yer değiştirilerek çalıştırılmalı"
 
Katılım
19 Haziran 2017
Mesajlar
219
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
05-04-2024
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
a = Target
b = Len(a) - Len(WorksheetFunction.Substitute(a, ",", "")) + 1
c = 1
For i = 1 To b
d = WorksheetFunction.Find(",", a, c)
If d < c Then d = Len(a) + 1
e = Mid(a, c, d - c) * 1
f = WorksheetFunction.VLookup(e, Sheets("Sayfa1").Range("C6:D18"), 2, 0)
g = f & ","
h = h & g
c = d + 1
Next
1:
Target.Cells.Offset(0, 1).Value = Left(h, Len(h) - 1)
End Sub


Başka bir forumda cevap gelmiş konuya ancak, kodu çalıştıramadım ancak. Buton eklemeye çalıştım hata verdi.


"Sayfa1 deki C ve D sütunlarını yer değiştirilerek çalıştırılmalı"
Kodun çalışmadığını söyledim diğer forumdaki arkadaşa, örnek dosya yükledi hayli sevindim, ancak dosya virüslü olduğu için açamadım. bu Forumdan yüzlerce dosya indirmiştim hiç böyle birşeyle karşılaşmadım. Tekrar emek ve zaman harcayan herkese teşekkür ederim

Yardıma muhtaç kişilerin müşkül durumlarını suiistimal ederek menfaat sağlamaya çalışanlar ne yazık ki içimizde.
 
Üst