VBA Başka bir sekmeden veri almak.

[cimeyil]

"günlük" sekmesine sadece personel ismini yazarak diğer tüm bilgilerin "personel" listesi sekmesnden alması için bir kod yazar mısınız . yani günlük sekmesine b5 hücresinden b250 ye kadar personel isimleri girilecek. bu personeller için bilgileri c5:c250 ve d5:d250 ye otomatik yazacak . düşey ara formülünün makro ile yapılması diyebiliriz.

 

[netzone]

Merhaba,

Mevcut çalışmanızın Kişisel veriler içermeyen bir kopyasını paylaşırsanız daha çabuk ve kesin çözüme ulaşmanız kolay olur.
yada forum üzerinde bulunan benzer konuları inceleyebilirsiniz.

*Ayrıca başlıkta yer alan "ACİL" yazısını forum kuralları gereği kaldırmanızı rica ederiz.

İyi çalışmalar.

 

[cimeyil]

dosyayı nasıl eklerim konuya ?

 

[YUSUF44]

Altın üye değilseniz dosya paylaşım sitelerinden birine yükleyip burada paylaşabilirsiniz.

 

[cimeyil]

http://www.mediafire.com/file/sgo3c04ahtysfos/1.xlsx/file

 

[YUSUF44]

Dosyanızda "günlük" diye bir sekme göremedim.

 

[cimeyil]

1 den 31 e kadar gün sekmeleri mevcut bu sekmelerdeki "B" kolonuna o gün çalışan personelleri yazdığım zaman"C,D,E,F" kolonlarına karşısına bilgileri "Persn. List" sekmesindeki bilgilerini getirmesi gerekiyor. bu işlemi düşeyara formülü ile yaptım ancak çok fazla bir kasıntı var hesaplama yaparken rahat çalışılamıyor . bu yüzden makro ile yapılırsa daha seri olacağına inanıyorum . yardımlarınız için teşekkür ederim.

 

[YUSUF44]

Aşağıdaki kodları dosyanızın ThisWorkbook kod bölümüne ekleyip deneyin:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "1" Or ActiveSheet.Name = "2" Or ActiveSheet.Name = "3" Or ActiveSheet.Name = "4" Or ActiveSheet.Name = "5" Or ActiveSheet.Name = "6" _
    Or ActiveSheet.Name = "7" Or ActiveSheet.Name = "8" Or ActiveSheet.Name = "9" Or ActiveSheet.Name = "10" Or ActiveSheet.Name = "11" Or ActiveSheet.Name = "12" _
    Or ActiveSheet.Name = "13" Or ActiveSheet.Name = "14" Or ActiveSheet.Name = "15" Or ActiveSheet.Name = "16" Or ActiveSheet.Name = "17" Or ActiveSheet.Name = "18" _
    Or ActiveSheet.Name = "19" Or ActiveSheet.Name = "20" Or ActiveSheet.Name = "21" Or ActiveSheet.Name = "22" Or ActiveSheet.Name = "23" Or ActiveSheet.Name = "24" _
    Or ActiveSheet.Name = "25" Or ActiveSheet.Name = "26" Or ActiveSheet.Name = "27" Or ActiveSheet.Name = "28" Or ActiveSheet.Name = "29" Or ActiveSheet.Name = "30" _
    Or ActiveSheet.Name = "31" Then
        If Intersect(Target, [B5:B520]) Is Nothing Then Exit Sub
        If Selection.Count > 1 Then Exit Sub
        Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 2, 0)
        Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 4, 0)
        Target.Offset(0, 3) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 5, 0)
        Target.Offset(0, 4) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 6, 0)
End If
End Sub

 

[cimeyil]

teşekkür ederim istediğim oldu . fakat başka bir sekmeden de "I" sütununa veri almak istiyorum . "H" sütununa yazıldığında gelmesi lazım . bir kısmı aşağıdaki gibi olacak sanırım da . nereye ekleneceğini bilemedim. Kısaca H sütununa 0.0.1 yazıldığında I sütununa ("Daily Total MH" B:C) sekmesinden "Site İnduction" yazılması gerekiyor. yardımcı olur musunuz .



If Intersect(Target, [H5:H520]) Is Nothing Then Exit Sub
Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("Daily Total MH").[B6:C10000], 2, 0)

 

[YUSUF44]

Aşağıdaki gibi deneyin. Resume next kısmı, hatalı/tabloda olmayan bir kod yazıldığında makronun hata vermesini önlemek için:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If ActiveSheet.Name = "1" Or ActiveSheet.Name = "2" Or ActiveSheet.Name = "3" Or ActiveSheet.Name = "4" Or ActiveSheet.Name = "5" Or ActiveSheet.Name = "6" _
    Or ActiveSheet.Name = "7" Or ActiveSheet.Name = "8" Or ActiveSheet.Name = "9" Or ActiveSheet.Name = "10" Or ActiveSheet.Name = "11" Or ActiveSheet.Name = "12" _
    Or ActiveSheet.Name = "13" Or ActiveSheet.Name = "14" Or ActiveSheet.Name = "15" Or ActiveSheet.Name = "16" Or ActiveSheet.Name = "17" Or ActiveSheet.Name = "18" _
    Or ActiveSheet.Name = "19" Or ActiveSheet.Name = "20" Or ActiveSheet.Name = "21" Or ActiveSheet.Name = "22" Or ActiveSheet.Name = "23" Or ActiveSheet.Name = "24" _
    Or ActiveSheet.Name = "25" Or ActiveSheet.Name = "26" Or ActiveSheet.Name = "27" Or ActiveSheet.Name = "28" Or ActiveSheet.Name = "29" Or ActiveSheet.Name = "30" _
    Or ActiveSheet.Name = "31" Then
       If Intersect(Target, [B5:B520]) Is Nothing Then GoTo 10
        If Selection.Count > 1 Then Exit Sub
        Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 2, 0)
        Target.Offset(0, 2) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 4, 0)
        Target.Offset(0, 3) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 5, 0)
        Target.Offset(0, 4) = WorksheetFunction.VLookup(Target, Sheets("Persn. List").[C4:L10000], 6, 0)
10:
        If Intersect(Target, [H5:H520]) Is Nothing Then Exit Sub
        If Selection.Count > 1 Then Exit Sub
        Target.Offset(0, 1) = WorksheetFunction.VLookup(Target, Sheets("Daily Total MH").[B6:C10000], 2, 0)
End If
End Sub

 

[cimeyil]

yardımınız için çok teşekkür ederim .çalışıyor. fakat başka bir excellden isimleri veri yapıştırdığım zaman makro otomatik çalışmıyor. hücre içine girip entere bastığımda çalışıyor. bunu çözebilir miyiz.

ayrıca ,
dosyada hala çok fazla kasma oluyor hesaplarken . Acaba bunun sebebi Monthly Total Foreman MH sekmesindeki formüllerden mi kaynaklıdır. bu formülleri de makro ile yapabilir miyiz.

 

[cimeyil]

yapabilecek misiniz?

 

[cimeyil]

aynı zamanda CTRL+Z çalışmıyor dosyada .dosya uzantısı xlsm olarak geçiyor. bu şekilde kaydetmemi istemişti.

 

[YUSUF44]

Verdiğim kodlar sayfada yapılan değişikliklere bağlı olarak çalışıyor. Çoklu kopyalama için uygun değil maalesef. Eğer çoklu işlem yapılmak isteniyorsa sayfa olayları yerine makro yazılabilir. Aşağıdaki kodları dosyanıza bir modül ekleyip deneyiniz:

Sub formul()
On Error Resume Next
Set s1 = Sheets("Persn. List")
Set s2 = Sheets("Daily Total MH")

If ActiveSheet.Name = "1" Or ActiveSheet.Name = "2" Or ActiveSheet.Name = "3" Or ActiveSheet.Name = "4" Or ActiveSheet.Name = "5" Or ActiveSheet.Name = "6" _
    Or ActiveSheet.Name = "7" Or ActiveSheet.Name = "8" Or ActiveSheet.Name = "9" Or ActiveSheet.Name = "10" Or ActiveSheet.Name = "11" Or ActiveSheet.Name = "12" _
    Or ActiveSheet.Name = "13" Or ActiveSheet.Name = "14" Or ActiveSheet.Name = "15" Or ActiveSheet.Name = "16" Or ActiveSheet.Name = "17" Or ActiveSheet.Name = "18" _
    Or ActiveSheet.Name = "19" Or ActiveSheet.Name = "20" Or ActiveSheet.Name = "21" Or ActiveSheet.Name = "22" Or ActiveSheet.Name = "23" Or ActiveSheet.Name = "24" _
    Or ActiveSheet.Name = "25" Or ActiveSheet.Name = "26" Or ActiveSheet.Name = "27" Or ActiveSheet.Name = "28" Or ActiveSheet.Name = "29" Or ActiveSheet.Name = "30" _
    Or ActiveSheet.Name = "31" Then
    
    sonb = ActiveSheet.Cells(Rows.Count, "B").End(3).Row
    For i = 5 To sonb
        If ActiveSheet.Cells(i, "B") <> "" Then
            ActiveSheet.Cells(i, "C") = WorksheetFunction.VLookup(ActiveSheet.Cells(i, "B"), Sheets("Persn. List").[C4:L10000], 2, 0)
            ActiveSheet.Cells(i, "D") = WorksheetFunction.VLookup(ActiveSheet.Cells(i, "B"), Sheets("Persn. List").[C4:L10000], 4, 0)
            ActiveSheet.Cells(i, "E") = WorksheetFunction.VLookup(ActiveSheet.Cells(i, "B"), Sheets("Persn. List").[C4:L10000], 5, 0)
            ActiveSheet.Cells(i, "C") = WorksheetFunction.VLookup(ActiveSheet.Cells(i, "B"), Sheets("Persn. List").[C4:L10000], 2, 0)
        End If
    Next
        
    sonh = ActiveSheet.Cells(Rows.Count, "H").End(3).Row
    For i = 5 To sonh
        If ActiveSheet.Cells(i, "H") <> "" Then
            ActiveSheet.Cells(i, "I") = WorksheetFunction.VLookup(ActiveSheet.Cells(i, "H"), Sheets("Daily Total MH").[B6:C10000], 2, 0)
        End If
    Next
End If
End Sub

Bende dosyanız kasılma yapmadı. Ancak kasılıyorsa birbiriyle bağlantılı fazla formül olmasından kaynaklanabilir. Bu nedenle formüller yerine makro kullanmak işlerinizi hızlandırabilir.

CTRL+Z yani işlem geri alma makrolu işlemlerde geçerli olmuyor maalesef.

Office 2007 sürümünden itibaren normal excel dosyaları xlsx ve makrolu olanlar xlsm uzantılı olarak kaydediliyor. Önceden hepsi xls uzantılıydı.

Dosyanızda monthly total foreman diye bir sayfa bulunmuyor.

Dosyanızda kasılmaları önlemek için gereksiz biçimlendirmeden kaçınıp olabildiğince sade bir tasarım kullanmak, birbiriyle bağlantılı uzun formüller yerine kısa formüller ya da makro kullanmak, boş satırlar için gereksiz formül kullanmamak gibi çözümler bulunabilir.

 

[cimeyil]

Daily Total Foreman MH olacak pardon bir sürü "çok etopla" formülü var . bunları makro ile yapabilir miyiz. ve gönderdiğiniz kod module yazdığımda çalışmıyordu kontrol ettiğimde aynı tanımlama vardı 2 tane değiştirdim. Kısayol atadım makro çalışması için sorunum düzeldi. sadece ÇOK ETOPLA formülünün makro ile kullanımı kaldı. Daily Total Foreman MH sekmesindeki formülleri makro ile yapmak istiyorum . orası bayağı bir sıkıntılı

 

[YUSUF44]

Makro yazılabilir ama maalesef o kadar uzun formülü makroyla yazamam, vaktim yok.

Modüldeki makrolar daha doğrusu sayfa olayına bağlı olmayan makrolar çalışmak için bir tetikleyiciye ihtiyaç duyarlar. Örneğin sayfanıza bir düğme/resim/şekil ekleyin ve eklediğiniz düğme/resim/şekil üzerine sağ tıklayıp makro ata diyerek son verdiğim makroyu seçin. Daha sonra o eklediğiniz düğmeye/resme/şekle bastığınızda makro çalışacaktır.