Sayfalar Arasında Veri Akışı

  • Konuyu başlatan Konuyu başlatan Noartist
  • Başlangıç tarihi Başlangıç tarihi
Katılım
28 Tem 2022
Mesajlar
85
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Merhaba Arkadaşlar,

Ekteki excel dosyasında üçüncü sayfadaki Sicil sayfasında tam kullanıcı listesi var,
burada kullanıcıların sicil numaraları ve kullanıcı ad ları bulunuyor,
Ozet sayfasında bulunan kullanıcıların sicil numaralarını Sicil sayfasından alıp Ozet sayfasındaki C sutununa işlemesinmesi gerekmektedir.
Bunu dosyadaki mevcut makroya ekleyebilirsek ve rapor butonuna basıldığında hepsini bir adımda yapabilirsek çok güzel olur.
Yardımcı olabilirseniz çok sevinirim.
 

Ekli dosyalar

Merhabalar Sn. Noartist
Ekteki dosyayı dener misiniz?

AhmetRasim hocam öncelikle elinize sağlık,
User-List sayfasındaki veriler orjinalinde sicil numaraları karışık olacak ve kullanıcı listeside isim.soyisim şeklinde karışık olacak,
Ozet sayfasında user1, user2, user3 ... gibi sırayla devam ettiğinde Rapora bastığımda Sicil numarasını C satırına işliyor ancak
Sıralamayı bozduğumda user1, user3, user4, user2 şeklinde sıralama karışık olduğunda Rapora bastığımda işlemiyor.
 
Merhabalar Sn. Noartist

Module içindeki Sicil kodlarını aşağıdaki kodlar ile değiştiriniz.
VBA:
Sub Sicil()
Application.ScreenUpdating = False
Set ana = Sheets("Ozet"): Set user = Sheets("User-List")
user_son = user.Cells(Rows.Count, 1).End(3).Row
ason = ana.Cells(Rows.Count, 1).End(3).Row
ana.Range("C2:C" & user_son).ClearContents

On Error Resume Next
For sat = 2 To user_son
user.Select
    
    user.Cells.Find(What:=ana.Cells(sat, "D").Value).Select
    ana.Cells(sat, "C") = user.Range(ActiveCell.Address).Offset(0, -1).Value
    
Next
ana.Select
Application.ScreenUpdating = True

End Sub
 
Merhabalar Sn. Noartist

Module içindeki Sicil kodlarını aşağıdaki kodlar ile değiştiriniz.
VBA:
Sub Sicil()
Application.ScreenUpdating = False
Set ana = Sheets("Ozet"): Set user = Sheets("User-List")
user_son = user.Cells(Rows.Count, 1).End(3).Row
ason = ana.Cells(Rows.Count, 1).End(3).Row
ana.Range("C2:C" & user_son).ClearContents

On Error Resume Next
For sat = 2 To user_son
user.Select
   
    user.Cells.Find(What:=ana.Cells(sat, "D").Value).Select
    ana.Cells(sat, "C") = user.Range(ActiveCell.Address).Offset(0, -1).Value
   
Next
ana.Select
Application.ScreenUpdating = True

End Sub

AhmetRasim hocam çok teşekkür ederim tam istediğim gibi olmuş,
küçük bir isteğim daha olacak eklediğim görselde sicil no satırında kullanıcı adı olmayanlar için User Name olarak devam ediyor, kullanıcı adı yoksa boş gözükmesini sağlayabilirmiyiz ?
 

Ekli dosyalar

  • son.webp
    son.webp
    18.5 KB · Görüntüleme: 43
Merhabalar Sn. Noartist

Biraz yavaşlamaya neden olur ama kullanıcı adı olmayanların karşısı boş kalır.
VBA:
Sub Sicil()

Application.ScreenUpdating = False
Set ana = Sheets("Ozet"): Set user = Sheets("User-List")
user_son = user.Cells(Rows.Count, 1).End(3).Row
ason = ana.Cells(Rows.Count, 1).End(3).Row
ana.Range("C2:C" & user_son).ClearContents

On Error Resume Next
For sat = 2 To user_son
user.Select

say = WorksheetFunction.CountIf(user.Range("B2:B" & user_son), ana.Cells(sat, "D"))

If say = 1 Then
    user.Cells.Find(What:=ana.Cells(sat, "D").Value).Select
    ana.Cells(sat, "C") = user.Range(ActiveCell.Address).Offset(0, -1).Value
End If
Next

ana.Select
Application.ScreenUpdating = True

End Sub
 
Merhabalar Sn. Noartist

Biraz yavaşlamaya neden olur ama kullanıcı adı olmayanların karşısı boş kalır.
VBA:
Sub Sicil()

Application.ScreenUpdating = False
Set ana = Sheets("Ozet"): Set user = Sheets("User-List")
user_son = user.Cells(Rows.Count, 1).End(3).Row
ason = ana.Cells(Rows.Count, 1).End(3).Row
ana.Range("C2:C" & user_son).ClearContents

On Error Resume Next
For sat = 2 To user_son
user.Select

say = WorksheetFunction.CountIf(user.Range("B2:B" & user_son), ana.Cells(sat, "D"))

If say = 1 Then
    user.Cells.Find(What:=ana.Cells(sat, "D").Value).Select
    ana.Cells(sat, "C") = user.Range(ActiveCell.Address).Offset(0, -1).Value
End If
Next

ana.Select
Application.ScreenUpdating = True

End Sub
AhmetRasim hocam çok teşekkür ederim, çok güzel olmuş, elinize emeğinize sağlık.
 
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst Alt